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     sysutils;\r
  29 \r
  30 //convert a name to an IP\r
  31 //will return v4 or v6 depending on what seems favorable, or manual preference setting\r
  32 //on error the binip will have a family of 0 (other fiels are also currently\r
  33 //zeroed out but may be used for further error information in future)\r
  34 //timeout is in miliseconds, it is ignored when using windows dns\r
  35 function forwardlookup(name:string;timeout:integer):tbinip;\r
  36 \r
  37 //convert a name to a list of all IP's returned\r
  38 //this returns both v4 and v6 IP's, or possibly only v4 or v6, depending on settings\r
  39 //on error, returns an empty list\r
  40 function forwardlookuplist(name:string;timeout:integer):tbiniplist;\r
  41 \r
  42 \r
  43 //convert an IP to a name, on error a null string will be returned, other\r
  44 //details as above\r
  45 function reverselookup(ip:tbinip;timeout:integer):string;\r
  46 \r
  47 {$ifdef linux}{$ifdef ipv6}\r
  48 function getv6localips:tbiniplist;\r
  49 procedure initpreferredmode;\r
  50 \r
  51 var\r
  52   preferredmodeinited:boolean;\r
  53 \r
  54 {$endif}{$endif}\r
  55 \r
  56 const\r
  57   tswrap=$4000;\r
  58   tsmask=tswrap-1;\r
  59 \r
  60   numsock=1{$ifdef ipv6}+1{$endif};\r
  61   defaulttimeout=10000;\r
  62   const mintimeout=16;\r
  63 \r
  64 var\r
  65   dnssyncserver:string;\r
  66   id:integer;\r
  67 \r
  68   sendquerytime:array[0..numsock-1] of integer;\r
  69 implementation\r
  70 \r
  71 {$ifdef win32}\r
  72   uses dnswin;\r
  73 {$endif}\r
  74 \r
  75 \r
  76 {$ifndef win32}\r
  77 {$define syncdnscore}\r
  78 {$endif}\r
  79 \r
  80 {$i unixstuff.inc}\r
  81 {$i ltimevalstuff.inc}\r
  82 \r
  83 var\r
  84   numsockused:integer;\r
  85   fd:array[0..numsock-1] of integer;\r
  86   state:array[0..numsock-1] of tdnsstate;\r
  87 \r
  88 {$ifdef syncdnscore}\r
  89 \r
  90 {$ifdef win32}\r
  91   const\r
  92     winsocket = 'wsock32.dll';\r
  93   function sendto(s: TSocket; const Buf; len, flags: Integer; var addrto: TinetSockAddrV; tolen: Integer): Integer; stdcall; external    winsocket name 'sendto';\r
  94   function bind(s: TSocket; var addr: TinetSockAddrV; namelen: Integer): Longbool; stdcall; external    winsocket name 'bind';\r
  95   type\r
  96     fdset=tfdset;\r
  97 {$endif}\r
  98 \r
  99 \r
 100 function getts:integer;\r
 101 {$ifdef win32}\r
 102 begin\r
 103   result := GetTickCount and tsmask;\r
 104 {$else}\r
 105 var\r
 106   temp:ttimeval;\r
 107 begin\r
 108   gettimeofday(temp);\r
 109   result := ((temp.tv_usec div 1000) + (temp.tv_sec * 1000)) and tsmask;\r
 110 {$endif}\r
 111 end;\r
 112 \r
 113 \r
 114 function sendquery(socknum:integer;const packet:tdnspacket;len:integer):boolean;\r
 115 var\r
 116   a:integer;\r
 117   addr       : string;\r
 118   port       : string;\r
 119   inaddr     : TInetSockAddrV;\r
 120 begin\r
 121 {  writeln('sendquery ',decodename(state.packet,state.packetlen,12,0,a),' ',state.requesttype);}\r
 122   result := false;\r
 123   if len = 0 then exit; {no packet}\r
 124 \r
 125   if dnssyncserver <> '' then addr := dnssyncserver else addr := getcurrentsystemnameserver(id);\r
 126   port := '53';\r
 127 \r
 128   makeinaddrv(ipstrtobinf(addr),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:string;\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 dnssyncserver <> '' then addr := dnssyncserver else addr := getcurrentsystemnameserver(id);\r
 146   //must get the DNS server here so we know to init v4 or v6\r
 147 \r
 148   fillchar(inaddrtemp,sizeof(inaddrtemp),0);\r
 149   ipstrtobin(addr,biniptemp);\r
 150   if biniptemp.family = 0 then biniptemp.family := AF_INET;\r
 151 \r
 152   inaddrtemp.inaddr.family := biniptemp.family;\r
 153 \r
 154   for a := 0 to numsockused-1 do begin\r
 155     fd[a] := Socket(biniptemp.family,SOCK_DGRAM,0);\r
 156 \r
 157     If {$ifndef win32}Not{$endif} Bind(fd[a],inAddrtemp,inaddrsize(inaddrtemp)) Then begin\r
 158       {$ifdef win32}\r
 159         raise Exception.create('unable to bind '+inttostr(WSAGetLastError));\r
 160       {$else}\r
 161         raise Exception.create('unable to bind '+inttostr(socketError));\r
 162       {$endif}\r
 163     end;\r
 164   end;\r
 165 end;\r
 166 \r
 167 procedure resolveloop(timeout:integer);\r
 168 var\r
 169   selectresult   : integer;\r
 170   fds            : fdset;\r
 171 \r
 172   endtime      : longint;\r
 173   starttime    : longint;\r
 174   wrapmode     : boolean;\r
 175   currenttime  : integer;\r
 176 \r
 177   lag            : ttimeval;\r
 178   currenttimeout : 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 begin\r
 186   if timeout < mintimeout then timeout := defaulttimeout;\r
 187 \r
 188     starttime := getts;\r
 189     endtime := starttime + timeout;\r
 190     if (endtime and tswrap)=0 then begin\r
 191       wrapmode := false;\r
 192     end else begin\r
 193       wrapmode := true;\r
 194     end;\r
 195     endtime := endtime and tsmask;\r
 196 \r
 197   setupsocket;\r
 198   for socknum := 0 to numsockused-1 do begin\r
 199     needprocessing[socknum] := true;\r
 200     finished[socknum] := false;\r
 201   end;\r
 202 \r
 203   repeat\r
 204     for socknum := numsockused-1 downto 0 do if needprocessing[socknum] then begin\r
 205       state_process(state[socknum]);\r
 206       case state[socknum].resultaction of\r
 207         action_ignore: begin\r
 208           {do nothing}\r
 209         end;\r
 210         action_done: begin\r
 211           finished[socknum] := true;\r
 212           //exit if all resolvers are finished\r
 213           b := 0;\r
 214           for a := 0 to numsockused-1 do begin\r
 215             if finished[a] then inc(b);\r
 216           end;\r
 217           if (b = numsockused) then begin\r
 218             exit;\r
 219           end;\r
 220           //onrequestdone(self,0);\r
 221         end;\r
 222         action_sendquery:begin\r
 223 {        writeln('send query');}\r
 224           sendquery(socknum,state[socknum].sendpacket,state[socknum].sendpacketlen);\r
 225         end;\r
 226       end;\r
 227       needprocessing[socknum] := false;\r
 228     end;\r
 229 \r
 230     currenttime := getts;\r
 231     msectotimeval(selecttimeout, (endtime-currenttime) and tsmask);\r
 232 \r
 233     fd_zero(fds);\r
 234     for socknum := numsockused-1 downto 0 do if not finished[socknum] then fd_set(fd[socknum],fds);\r
 235     if (selecttimeout.tv_sec > 0) or (selecttimeout.tv_usec > retryafter) then begin\r
 236       selecttimeout.tv_sec := 0;\r
 237       selecttimeout.tv_usec := retryafter;\r
 238     end;\r
 239     //find the highest of the used fd's\r
 240     b := 0;\r
 241     for socknum := numsockused-1 downto 0 do if fd[socknum] > b then b := fd[socknum];\r
 242     selectresult := select(b+1,@fds,nil,nil,@selecttimeout);\r
 243     if selectresult > 0 then begin\r
 244       currenttime := getts;\r
 245       for socknum := numsockused-1 downto 0 do if fd_isset(fd[socknum],fds) then begin\r
 246   {      writeln('selectresult>0');}\r
 247         //why the hell are we zeroing out the packet buffer before reading into it?! --plugwash\r
 248 \r
 249         fillchar(state[socknum].recvpacket,sizeof(state[socknum].recvpacket),0);\r
 250         msectotimeval(lag,(currenttime-sendquerytime[socknum]) and tsmask);\r
 251 \r
 252         if dnssyncserver = '' then reportlag(id,(lag.tv_sec*1000000)+lag.tv_usec);\r
 253         state[socknum].recvpacketlen := recv(fd[socknum],state[socknum].recvpacket, SizeOf(state[socknum].recvpacket),0);\r
 254         state[socknum].parsepacket := true;\r
 255         needprocessing[socknum] := true;\r
 256       end;\r
 257     end;\r
 258     if selectresult < 0 then exit;\r
 259     if selectresult = 0 then begin\r
 260 \r
 261       currenttime := getts;\r
 262 \r
 263       if dnssyncserver = '' then reportlag(id,-1);\r
 264       if (currenttime >= endtime) and ((not wrapmode) or (currenttime < starttime)) then begin\r
 265         exit;\r
 266       end else begin\r
 267         //resend\r
 268         for socknum := numsockused-1 downto 0 do begin\r
 269           sendquery(socknum,state[socknum].sendpacket,state[socknum].sendpacketlen);\r
 270         end;\r
 271       end;\r
 272     end;\r
 273   until false;\r
 274 end;\r
 275 {$endif}\r
 276 \r
 277 procedure addipsoffamily(var l:tbiniplist;const l2:tbiniplist;family:integer);\r
 278 var\r
 279   a:integer;\r
 280   biniptemp:tbinip;\r
 281 begin\r
 282   for a := biniplist_getcount(l2)-1 downto 0 do begin\r
 283     biniptemp := biniplist_get(l2,a);\r
 284     if (biniptemp.family = family) then biniplist_add(l,biniptemp);\r
 285   end;\r
 286 end;\r
 287 \r
 288 \r
 289 function forwardlookuplist(name:string;timeout:integer):tbiniplist;\r
 290 var\r
 291   dummy : integer;\r
 292   a,b:integer;\r
 293   biniptemp:tbinip;\r
 294   l:tbiniplist;\r
 295 begin\r
 296   ipstrtobin(name,biniptemp);\r
 297   if biniptemp.family <> 0 then begin\r
 298     result := biniplist_new;\r
 299     biniplist_add(result,biniptemp);\r
 300     exit; //it was an IP address, no need for dns\r
 301   end;\r
 302 \r
 303   {$ifdef win32}\r
 304   if usewindns then begin\r
 305     if (useaf = useaf_v4) then a := af_inet else if (useaf = useaf_v6) then a := af_inet6 else a := 0;\r
 306     result := winforwardlookuplist(name,a,dummy);\r
 307     {$ifdef ipv6}\r
 308     if (useaf = useaf_preferv4) then begin\r
 309       {prefer mode: sort the IP's}\r
 310       l := biniplist_new;\r
 311       addipsoffamily(l,result,af_inet);\r
 312       addipsoffamily(l,result,af_inet6);\r
 313       result := l;\r
 314     end;\r
 315     if (useaf = useaf_preferv6) then begin\r
 316       {prefer mode: sort the IP's}\r
 317       l := biniplist_new;\r
 318       addipsoffamily(l,result,af_inet6);\r
 319       addipsoffamily(l,result,af_inet);\r
 320       result := l;\r
 321     end;\r
 322     {$endif}\r
 323   end else\r
 324   {$endif}\r
 325   begin\r
 326   {$ifdef syncdnscore}\r
 327     {$ifdef linux}{$ifdef ipv6}initpreferredmode;{$endif}{$endif}\r
 328 \r
 329     numsockused := 0;\r
 330 \r
 331     result := biniplist_new;\r
 332     if (useaf <> useaf_v6) then begin\r
 333       setstate_forward(name,state[numsockused],af_inet);\r
 334       inc(numsockused);\r
 335     end;\r
 336     {$ifdef ipv6}\r
 337     if (useaf <> useaf_v4) then begin\r
 338       setstate_forward(name,state[numsockused],af_inet6);\r
 339       inc(numsockused);\r
 340     end;\r
 341     {$endif}\r
 342 \r
 343     resolveloop(timeout);\r
 344 \r
 345     if (numsockused = 1) then begin\r
 346       biniplist_addlist(result,state[0].resultlist);\r
 347     {$ifdef ipv6}\r
 348     end else if (useaf = useaf_preferv6) then begin\r
 349       biniplist_addlist(result,state[1].resultlist);\r
 350       biniplist_addlist(result,state[0].resultlist);\r
 351     end else begin\r
 352       biniplist_addlist(result,state[0].resultlist);\r
 353       biniplist_addlist(result,state[1].resultlist);\r
 354     {$endif}  \r
 355     end;\r
 356     {$endif}\r
 357   end;\r
 358 end;\r
 359 \r
 360 function forwardlookup(name:string;timeout:integer):tbinip;\r
 361 var\r
 362   listtemp:tbiniplist;\r
 363 begin\r
 364   listtemp := forwardlookuplist(name,timeout);\r
 365   result := biniplist_get(listtemp,0);\r
 366 end;\r
 367 \r
 368 function reverselookup(ip:tbinip;timeout:integer):string;\r
 369 var\r
 370   dummy : integer;\r
 371 begin\r
 372   {$ifdef win32}\r
 373     if usewindns then begin\r
 374       result := winreverselookup(ip,dummy);\r
 375       exit;\r
 376     end;\r
 377   {$endif}\r
 378   {$ifdef syncdnscore}\r
 379   setstate_reverse(ip,state[0]);\r
 380   numsockused := 1;\r
 381   resolveloop(timeout);\r
 382   result := state[0].resultstr;\r
 383   {$endif}\r
 384 end;\r
 385 \r
 386 {$ifdef linux}{$ifdef ipv6}{$ifdef syncdnscore}\r
 387 function getv6localips:tbiniplist;\r
 388 var\r
 389   t:textfile;\r
 390   s,s2:string;\r
 391   ip:tbinip;\r
 392   a:integer;\r
 393 begin\r
 394   result := biniplist_new;\r
 395 \r
 396   assignfile(t,'/proc/net/if_inet6');\r
 397   {$i-}reset(t);{$i+}\r
 398   if ioresult <> 0 then exit; {none found, return empty list}\r
 399 \r
 400   while not eof(t) do begin\r
 401     readln(t,s);\r
 402     s2 := '';\r
 403     for a := 0 to 7 do begin\r
 404       if (s2 <> '') then s2 := s2 + ':';\r
 405       s2 := s2 + copy(s,(a shl 2)+1,4);\r
 406     end;\r
 407     ipstrtobin(s2,ip);\r
 408     if ip.family <> 0 then biniplist_add(result,ip);\r
 409   end;\r
 410   closefile(t);\r
 411 end;\r
 412 \r
 413 procedure initpreferredmode;\r
 414 var\r
 415   l:tbiniplist;\r
 416   a:integer;\r
 417   ip:tbinip;\r
 418   ipmask_global,ipmask_6to4,ipmask_teredo:tbinip;\r
 419 \r
 420 begin\r
 421   if preferredmodeinited then exit;\r
 422   if useaf <> useaf_default then exit;\r
 423   useaf := useaf_preferv4;\r
 424   l := getv6localips;\r
 425   ipstrtobin('2000::',ipmask_global);\r
 426   ipstrtobin('2001::',ipmask_teredo);\r
 427   ipstrtobin('2002::',ipmask_6to4);\r
 428   {if there is any v6 IP which is globally routable and not 6to4 and not teredo, prefer v6}\r
 429   for a := biniplist_getcount(l)-1 downto 0 do begin\r
 430     ip := biniplist_get(l,a);\r
 431     if not comparebinipmask(ip,ipmask_global,3) then continue;\r
 432     if comparebinipmask(ip,ipmask_teredo,32) then continue;\r
 433     if comparebinipmask(ip,ipmask_6to4,16) then continue;\r
 434     useaf := useaf_preferv6;\r
 435     preferredmodeinited := true;\r
 436     exit;\r
 437   end;\r
 438 end;\r
 439 \r
 440 {$endif}{$endif}{$endif}\r
 441 \r
 442 {$ifdef win32}\r
 443   var\r
 444     wsadata : twsadata;\r
 445 \r
 446   initialization\r
 447     WSAStartUp($2,wsadata);\r
 448   finalization\r
 449     WSACleanUp;\r
 450 {$endif}\r
 451 end.\r
 452 \r
 453 \r