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