dnsasync.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 \r
   6 //FIXME: this code only ever seems to use one dns server for a request and does\r
   7 //not seem to have any form of retry code.\r
   8 \r
   9 unit dnsasync;\r
  10 {$ifdef fpc}\r
  11   {$mode delphi}\r
  12 {$endif}\r
  13 interface\r
  14 \r
  15 {$include lcoreconfig.inc}\r
  16 \r
  17 uses\r
  18   {$ifdef winasyncdns}\r
  19     dnswin,\r
  20   {$endif}\r
  21   lsocket,lcore,\r
  22   classes,binipstuff,dnscore,btime,lcorernd;\r
  23 \r
  24 const\r
  25   numsock=1{$ifdef ipv6}+1{$endif};\r
  26 \r
  27 type\r
  28 \r
  29   //after completion or cancelation a dnswinasync may be reused\r
  30   tdnsasync=class(tcomponent)\r
  31 \r
  32   private\r
  33     //made a load of stuff private that does not appear to be part of the main\r
  34     //public interface. If you make any of it public again please consider the\r
  35     //consequences when using windows dns. --plugwash.\r
  36     sockets: array[0..numsock-1] of tlsocket;\r
  37 \r
  38     states: array[0..numsock-1] of tdnsstate;\r
  39 \r
  40     destinations: array[0..numsock-1] of tbinip;\r
  41 \r
  42     dnsserverids : array[0..numsock-1] of integer;\r
  43     startts:double;\r
  44     {$ifdef winasyncdns}\r
  45       dwas : tdnswinasync;\r
  46     {$endif}\r
  47 \r
  48     numsockused : integer;\r
  49     fresultlist : tbiniplist;\r
  50     requestaf : integer;\r
  51     procedure asyncprocess(socketno:integer);\r
  52     procedure receivehandler(sender:tobject;error:word);\r
  53     function sendquery(socketno:integer;const packet:tdnspacket;len:integer):boolean;\r
  54     {$ifdef winasyncdns}\r
  55       procedure winrequestdone(sender:tobject;error:word);\r
  56     {$endif}\r
  57 \r
  58   public\r
  59     onrequestdone:tsocketevent;\r
  60 \r
  61     //addr and port allow the application to specify a dns server specifically\r
  62     //for this dnsasync object. This is not a recommended mode of operation\r
  63     //because it limits the app to one dns server but is kept for compatibility\r
  64     //and special uses.\r
  65     addr,port:ansistring;\r
  66 \r
  67     overrideaf : integer;\r
  68 \r
  69     procedure cancel;//cancel an outstanding dns request\r
  70     function dnsresult:ansistring; //get result of dnslookup as a string\r
  71     procedure dnsresultbin(var binip:tbinip); //get result of dnslookup as a tbinip\r
  72     property dnsresultlist : tbiniplist read fresultlist;\r
  73     procedure forwardlookup(const name:ansistring); //start forward lookup,\r
  74                                                 //preferring ipv4\r
  75     procedure reverselookup(const binip:tbinip); //start reverse lookup\r
  76     procedure customlookup(const name:ansistring;querytype:integer); //start custom type lookup\r
  77 \r
  78     constructor create(aowner:tcomponent); override;\r
  79     destructor destroy; override;\r
  80 \r
  81   end;\r
  82 \r
  83 //function that the app can use to know whether the builtin or system resolver is being used\r
  84 function willusebuiltindns_async:boolean;\r
  85 \r
  86 implementation\r
  87 \r
  88 uses sysutils;\r
  89 \r
  90 \r
  91 function willusebuiltindns_async:boolean;\r
  92 begin\r
  93   result := true;\r
  94   {$ifdef winasyncdns}if usewindns and (overridednsserver = '') and not (hostsfile_disabled or hostsfile_onlylocalhost) then result := false;{$endif}\r
  95 end;\r
  96 \r
  97 \r
  98 constructor tdnsasync.create;\r
  99 begin\r
 100   inherited create(aowner);\r
 101   dnsserverids[0] := -1;\r
 102   sockets[0] := twsocket.create(self);\r
 103   sockets[0].tag := 0;\r
 104   {$ifdef ipv6}\r
 105     dnsserverids[1] := -1;\r
 106     sockets[1] := twsocket.Create(self);\r
 107     sockets[1].tag := 1;\r
 108   {$endif}\r
 109 end;\r
 110 \r
 111 destructor tdnsasync.destroy;\r
 112 var\r
 113   socketno : integer;\r
 114 begin\r
 115   for socketno := 0 to numsock -1 do begin\r
 116     if assigned(sockets[socketno]) then begin\r
 117       if dnsserverids[socketno] >= 0 then begin\r
 118         reportlag(dnsserverids[socketno],-1);\r
 119         dnsserverids[socketno] := -1;\r
 120       end;\r
 121       sockets[socketno].release;\r
 122       setstate_request_init('',states[socketno]);\r
 123     end;\r
 124   end;\r
 125 \r
 126   {$ifdef winasyncdns}\r
 127   if assigned(dwas) then begin\r
 128     dwas.release;\r
 129     dwas := nil;\r
 130   end;\r
 131   {$endif}\r
 132 \r
 133   inherited destroy;\r
 134 end;\r
 135 \r
 136 procedure tdnsasync.receivehandler(sender:tobject;error:word);\r
 137 var\r
 138   socketno : integer;\r
 139   Src    : TInetSockAddrV;\r
 140   SrcLen : Integer;\r
 141   fromip:tbinip;\r
 142   fromport:ansistring;\r
 143 begin\r
 144   socketno := tlsocket(sender).tag;\r
 145   //writeln('got a reply on socket number ',socketno);\r
 146   fillchar(states[socketno].recvpacket,sizeof(states[socketno].recvpacket),0);\r
 147 \r
 148   SrcLen := SizeOf(Src);\r
 149   states[socketno].recvpacketlen := twsocket(sender).ReceiveFrom(@(states[socketno].recvpacket), SizeOf(states[socketno].recvpacket), Src, SrcLen);\r
 150 \r
 151   fromip := inaddrvtobinip(Src);\r
 152   fromport := inttostr(htons(src.InAddr.port));\r
 153 \r
 154   if ((not comparebinip(fromip,destinations[socketno])) or (fromport <> port)) then begin\r
 155    // writeln('dnsasync received from wrong IP:port ',ipbintostr(fromip),'#',fromport,', expected ',ipbintostr(destinations[socketno]),'#',port);\r
 156     exit;\r
 157   end;\r
 158 \r
 159   states[socketno].parsepacket := true;\r
 160   if states[socketno].resultaction <> action_done then begin\r
 161     //we ignore packets that come after we are done\r
 162     if dnsserverids[socketno] >= 0 then begin\r
 163       reportlag(dnsserverids[socketno],trunc((wintimefloat-startts)*1000000));\r
 164       dnsserverids[socketno] := -1;\r
 165     end;\r
 166   {  writeln('received reply');}\r
 167 \r
 168     asyncprocess(socketno);\r
 169     //writeln('processed it');\r
 170   end else begin\r
 171     //writeln('ignored it because request is done');\r
 172   end;\r
 173 end;\r
 174 \r
 175 function tdnsasync.sendquery(socketno:integer;const packet:tdnspacket;len:integer):boolean;\r
 176 var\r
 177   destination : tbinip;\r
 178   inaddr : tinetsockaddrv;\r
 179   trytolisten:integer;\r
 180 begin\r
 181 {  writeln('sendquery ',decodename(state.packet,state.packetlen,12,0,a),' ',state.requesttype);}\r
 182   //writeln('trying to send query on socket number ',socketno);\r
 183   result := false;\r
 184   if len = 0 then exit; {no packet}\r
 185   if sockets[socketno].state <> wsconnected then begin\r
 186     startts := wintimefloat;\r
 187     if port = '' then port := '53';\r
 188     sockets[socketno].Proto := 'udp';\r
 189     sockets[socketno].ondataavailable := receivehandler;\r
 190 \r
 191     {we are going to bind on a random local port for the DNS request, against the kaminsky attack\r
 192     there is a small chance that we're trying to bind on an already used port, so retry a few times}\r
 193     for trytolisten := 3 downto 0 do begin\r
 194       try\r
 195         sockets[socketno].port := inttostr(1024 + randominteger(65536 - 1024));\r
 196         sockets[socketno].listen;\r
 197       except\r
 198         {writeln('failed to listen ',sockets[socketno].localport,' ',trytolisten);}\r
 199         if (trytolisten = 0) then begin\r
 200           result := false;\r
 201           exit;\r
 202         end;\r
 203       end;\r
 204     end;\r
 205 \r
 206   end;\r
 207   if addr <> '' then begin\r
 208     dnsserverids[socketno] := -1;\r
 209     destination := ipstrtobinf(addr);\r
 210   end else begin\r
 211     destination := getcurrentsystemnameserverbin(dnsserverids[socketno]);\r
 212   end;\r
 213   destinations[socketno] := destination;\r
 214 \r
 215   {$ifdef ipv6}{$ifdef mswindows}\r
 216   if destinations[socketno].family = AF_INET6 then if (requestaf = useaf_default) then requestaf := useaf_preferv6;\r
 217   {$endif}{$endif}\r
 218 \r
 219   makeinaddrv(destinations[socketno],port,inaddr);\r
 220   sockets[socketno].sendto(inaddr,sizeof(inaddr), @packet,len);\r
 221   result := true;\r
 222 \r
 223 \r
 224 end;\r
 225 \r
 226 procedure tdnsasync.asyncprocess(socketno:integer);\r
 227 begin\r
 228   state_process(states[socketno]);\r
 229   case states[socketno].resultaction of\r
 230     action_ignore: begin {do nothing} end;\r
 231     action_done: begin\r
 232       {$ifdef ipv6}\r
 233       if (numsockused = 1) or (states[socketno xor 1].resultaction=action_done) then\r
 234       //if using two sockets we need to wait until both sockets are in the done\r
 235       //state before firing the event\r
 236       {$endif}\r
 237       begin\r
 238         fresultlist := biniplist_new;\r
 239         if (numsockused = 1) then begin\r
 240           //writeln('processing for one state');\r
 241           biniplist_addlist(fresultlist,states[0].resultlist);\r
 242         {$ifdef ipv6}\r
 243         end else if (requestaf = useaf_preferv6) then begin\r
 244           //writeln('processing for two states, ipv6 preference');\r
 245           //writeln('merging lists '+biniplist_tostr(states[1].resultlist)+' and '+biniplist_tostr(states[0].resultlist));\r
 246           biniplist_addlist(fresultlist,states[1].resultlist);\r
 247           biniplist_addlist(fresultlist,states[0].resultlist);\r
 248         end else begin\r
 249           //writeln('processing for two states, ipv4 preference');\r
 250           biniplist_addlist(fresultlist,states[0].resultlist);\r
 251           biniplist_addlist(fresultlist,states[1].resultlist);\r
 252         {$endif}\r
 253         end;\r
 254         //writeln(biniplist_tostr(fresultlist));\r
 255         onrequestdone(self,0);\r
 256       end;\r
 257     end;\r
 258     action_sendquery:begin\r
 259       sendquery(socketno,states[socketno].sendpacket,states[socketno].sendpacketlen);\r
 260     end;\r
 261   end;\r
 262 end;\r
 263 \r
 264 procedure tdnsasync.forwardlookup;\r
 265 var\r
 266   bip : tbinip;\r
 267   i : integer;\r
 268   willusewindns:boolean;\r
 269 begin\r
 270   ipstrtobin(name,bip);\r
 271 \r
 272   if bip.family <> 0 then begin\r
 273     // it was an IP address\r
 274     fresultlist := biniplist_new;\r
 275     biniplist_add(fresultlist,bip);\r
 276     onrequestdone(self,0);\r
 277     exit;\r
 278   end;\r
 279 \r
 280   willusewindns := false;\r
 281   {$ifdef winasyncdns}\r
 282   if usewindns and (addr = '') and (overridednsserver = '') and not (hostsfile_disabled or hostsfile_onlylocalhost) then willusewindns := true;\r
 283   {$endif}\r
 284 \r
 285   if overrideaf = useaf_default then begin\r
 286     {$ifdef ipv6}\r
 287       if not willusewindns then initpreferredmode;\r
 288     {$endif}\r
 289     requestaf := useaf;\r
 290   end else begin\r
 291     requestaf := overrideaf;\r
 292   end;\r
 293 \r
 294   {$ifdef winasyncdns}\r
 295     if willusewindns then begin\r
 296       dwas := tdnswinasync.create;\r
 297       dwas.onrequestdone := winrequestdone;\r
 298 \r
 299       dwas.forwardlookup(name);\r
 300 \r
 301       exit;\r
 302     end;\r
 303   {$endif}\r
 304 \r
 305   if (((overridednsserver = '') and (addr = '')) or hostsfile_alsocustomserver) and (not hostsfile_disabled) then begin\r
 306     //try a hosts file lookup\r
 307     fresultlist := hostsfile_forwardlookuplist(name);\r
 308     if (biniplist_getcount(fresultlist) > 0) then begin\r
 309       onrequestdone(self,0);\r
 310       exit;\r
 311     end;\r
 312   end;\r
 313 \r
 314   numsockused := 0;\r
 315   fresultlist := biniplist_new;\r
 316   if (requestaf <> useaf_v6) then begin\r
 317     setstate_forward(name,states[numsockused],af_inet);\r
 318     inc(numsockused);\r
 319   end;\r
 320 \r
 321   {$ifdef ipv6}\r
 322     if (requestaf <> useaf_v4) then begin\r
 323       setstate_forward(name,states[numsockused],af_inet6);\r
 324       inc(numsockused);\r
 325     end;\r
 326   {$endif}\r
 327 \r
 328   for i := 0 to numsockused-1 do begin\r
 329     asyncprocess(i);\r
 330   end;\r
 331 end;\r
 332 \r
 333 procedure tdnsasync.reverselookup;\r
 334 begin\r
 335   {$ifdef winasyncdns}\r
 336     if usewindns and (addr = '') and (overridednsserver = '') and not (hostsfile_disabled or hostsfile_onlylocalhost) then begin\r
 337       dwas := tdnswinasync.create;\r
 338       dwas.onrequestdone := winrequestdone;\r
 339       dwas.reverselookup(binip);\r
 340       exit;\r
 341     end;\r
 342   {$endif}\r
 343 \r
 344   if (((overridednsserver = '') and (addr = '')) or hostsfile_alsocustomserver) and (not hostsfile_disabled) then begin\r
 345     //try a hosts file lookup\r
 346     states[0].resultstr := hostsfile_reverselookup(binip);\r
 347     if (states[0].resultstr <> '') then begin\r
 348       onrequestdone(self,0);\r
 349       exit;\r
 350     end;\r
 351   end;\r
 352 \r
 353   setstate_reverse(binip,states[0]);\r
 354   numsockused := 1;\r
 355   asyncprocess(0);\r
 356 end;\r
 357 \r
 358 procedure tdnsasync.customlookup;\r
 359 begin\r
 360   setstate_custom(name,querytype,states[0]);\r
 361   numsockused := 1;\r
 362   asyncprocess(0);\r
 363 end;\r
 364 \r
 365 function tdnsasync.dnsresult;\r
 366 begin\r
 367   if states[0].resultstr <> '' then result := states[0].resultstr else begin\r
 368     result := ipbintostr(biniplist_get(fresultlist,0));\r
 369   end;\r
 370 end;\r
 371 \r
 372 procedure tdnsasync.dnsresultbin(var binip:tbinip);\r
 373 begin\r
 374   binip := biniplist_get(fresultlist,0);\r
 375 end;\r
 376 \r
 377 procedure tdnsasync.cancel;\r
 378 var\r
 379   socketno : integer;\r
 380 begin\r
 381   {$ifdef winasyncdns}\r
 382     if assigned(dwas) then begin\r
 383       dwas.release;\r
 384       dwas := nil;\r
 385     end else\r
 386   {$endif}\r
 387   begin\r
 388     for socketno := 0 to numsock-1 do begin\r
 389       reportlag(dnsserverids[socketno],-1);\r
 390       dnsserverids[socketno] := -1;\r
 391 \r
 392       sockets[socketno].close;\r
 393     end;\r
 394 \r
 395   end;\r
 396   for socketno := 0 to numsock-1 do begin\r
 397     setstate_failure(states[socketno]);\r
 398 \r
 399   end;\r
 400   fresultlist := biniplist_new;\r
 401   onrequestdone(self,0);\r
 402 end;\r
 403 \r
 404 {$ifdef winasyncdns}\r
 405   procedure tdnsasync.winrequestdone(sender:tobject;error:word);\r
 406  \r
 407   begin\r
 408     if dwas.reverse then begin\r
 409       states[0].resultstr := dwas.name;\r
 410     end else begin \r
 411 \r
 412       {$ifdef ipv6}\r
 413       if (requestaf = useaf_preferv4) then begin\r
 414         {prefer mode: sort the IP's}\r
 415         fresultlist := biniplist_new;\r
 416         addipsoffamily(fresultlist,dwas.iplist,af_inet);\r
 417         addipsoffamily(fresultlist,dwas.iplist,af_inet6);\r
 418 \r
 419       end else if (requestaf = useaf_preferv6) then begin\r
 420         {prefer mode: sort the IP's}\r
 421         fresultlist := biniplist_new;\r
 422         addipsoffamily(fresultlist,dwas.iplist,af_inet6);\r
 423         addipsoffamily(fresultlist,dwas.iplist,af_inet);\r
 424         \r
 425       end else\r
 426       {$endif}\r
 427       begin\r
 428         fresultlist := dwas.iplist;\r
 429       end;\r
 430 \r
 431     end;\r
 432     dwas.release;\r
 433     onrequestdone(self,error);\r
 434   end;\r
 435 {$endif}\r
 436 end.\r