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