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