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;\r
  19 \r
  20 const\r
  21   numsock=1{$ifdef ipv6}+1{$endif};\r
  22 \r
  23 type\r
  24 \r
  25   //after completion or cancelation a dnswinasync may be reused\r
  26   tdnsasync=class(tcomponent)\r
  27 \r
  28   private\r
  29     //made a load of stuff private that does not appear to be part of the main\r
  30     //public interface. If you make any of it public again please consider the\r
  31     //consequences when using windows dns. --plugwash.\r
  32     sockets: array[0..numsock-1] of tlsocket;\r
  33 \r
  34     states: array[0..numsock-1] of tdnsstate;\r
  35 \r
  36     dnsserverids : array[0..numsock-1] of integer;\r
  37     startts:double;\r
  38     {$ifdef win32}\r
  39       dwas : tdnswinasync;\r
  40     {$endif}\r
  41 \r
  42     numsockused : integer;\r
  43     fresultlist : tbiniplist;\r
  44     requestaf : integer;\r
  45     procedure asyncprocess(socketno:integer);\r
  46     procedure receivehandler(sender:tobject;error:word);\r
  47     function sendquery(socketno:integer;const packet:tdnspacket;len:integer):boolean;\r
  48     {$ifdef win32}\r
  49       procedure winrequestdone(sender:tobject;error:word);\r
  50     {$endif}\r
  51 \r
  52   public\r
  53     onrequestdone:tsocketevent;\r
  54 \r
  55     //addr and port allow the application to specify a dns server specifically\r
  56     //for this dnsasync object. This is not a reccomended mode of operation\r
  57     //because it limits the app to one dns server but is kept for compatibility\r
  58     //and special uses.\r
  59     addr,port:string;\r
  60 \r
  61     overrideaf : integer;\r
  62 \r
  63     //A family value of AF_INET6 will give only\r
  64     //ipv6 results. Any other value will give ipv4 results in preference and ipv6\r
  65     //results if ipv4 results are not available;\r
  66     forwardfamily:integer;\r
  67 \r
  68     procedure cancel;//cancel an outstanding dns request\r
  69     function dnsresult:string; //get result of dnslookup as a string\r
  70     procedure dnsresultbin(var binip:tbinip); //get result of dnslookup as a tbinip\r
  71     property dnsresultlist : tbiniplist read fresultlist;\r
  72     procedure forwardlookup(const name:string); //start forward lookup,\r
  73                                                 //preffering ipv4\r
  74     procedure reverselookup(const binip:tbinip); //start reverse 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 dnsserverids[socketno] >= 0 then begin\r
 104       reportlag(dnsserverids[socketno],-1);\r
 105       dnsserverids[socketno] := -1;\r
 106     end;\r
 107     sockets[socketno].release;\r
 108     setstate_request_init('',states[socketno]);\r
 109   end;\r
 110   inherited destroy;\r
 111 end;\r
 112 \r
 113 procedure tdnsasync.receivehandler(sender:tobject;error:word);\r
 114 var\r
 115   socketno : integer;\r
 116 begin\r
 117   socketno := tlsocket(sender).tag;\r
 118   //writeln('got a reply on socket number ',socketno);\r
 119   fillchar(states[socketno].recvpacket,sizeof(states[socketno].recvpacket),0);\r
 120   states[socketno].recvpacketlen := twsocket(sender).Receive(@(states[socketno].recvpacket), SizeOf(states[socketno].recvpacket));\r
 121   states[socketno].parsepacket := true;\r
 122   if states[socketno].resultaction <> action_done then begin\r
 123     //we ignore packets that come after we are done\r
 124     if dnsserverids[socketno] >= 0 then begin\r
 125       reportlag(dnsserverids[socketno],trunc((unixtimefloat-startts)*1000));\r
 126       dnsserverids[socketno] := -1;\r
 127     end;\r
 128   {  writeln('received reply');}\r
 129 \r
 130     asyncprocess(socketno);\r
 131     //writeln('processed it');\r
 132   end else begin\r
 133     //writeln('ignored it because request is done');\r
 134   end;\r
 135 end;\r
 136 \r
 137 function tdnsasync.sendquery(socketno:integer;const packet:tdnspacket;len:integer):boolean;\r
 138 var\r
 139   destination : string;\r
 140   inaddr : tinetsockaddrv;\r
 141 begin\r
 142 {  writeln('sendquery ',decodename(state.packet,state.packetlen,12,0,a),' ',state.requesttype);}\r
 143   //writeln('trying to send query on socket number ',socketno);\r
 144   result := false;\r
 145   if len = 0 then exit; {no packet}\r
 146   if sockets[socketno].state <> wsconnected then begin\r
 147     startts := unixtimefloat;\r
 148     if port = '' then port := '53';\r
 149     sockets[socketno].Proto := 'udp';\r
 150     sockets[socketno].ondataavailable := receivehandler;\r
 151     try\r
 152       sockets[socketno].listen;\r
 153     except\r
 154       result := false;\r
 155       exit;\r
 156     end;\r
 157 \r
 158   end;\r
 159   if addr <> '' then begin\r
 160     dnsserverids[socketno] := -1;\r
 161     destination := addr\r
 162   end else begin\r
 163     destination := getcurrentsystemnameserver(dnsserverids[socketno]);\r
 164   end;\r
 165   makeinaddrv(ipstrtobinf(destination),port,inaddr);\r
 166   sockets[socketno].sendto(inaddr,sizeof(inaddr), @packet,len);\r
 167   result := true;\r
 168 \r
 169 \r
 170 end;\r
 171 \r
 172 procedure tdnsasync.asyncprocess(socketno:integer);\r
 173 begin\r
 174   state_process(states[socketno]);\r
 175   case states[socketno].resultaction of\r
 176     action_ignore: begin {do nothing} end;\r
 177     action_done: begin\r
 178       {$ifdef ipv6}\r
 179       if (numsockused = 1) or (states[socketno xor 1].resultaction=action_done) then\r
 180       //if using two sockets we need to wait until both sockets are in the done\r
 181       //state before firing the event\r
 182       {$endif}\r
 183       begin\r
 184         fresultlist := biniplist_new;\r
 185         if (numsockused = 1) then begin\r
 186           //writeln('processing for one state');\r
 187           biniplist_addlist(fresultlist,states[0].resultlist);\r
 188         {$ifdef ipv6}\r
 189         end else if (requestaf = useaf_preferv6) then begin\r
 190           //writeln('processing for two states, ipv6 preference');\r
 191           //writeln('merging lists '+biniplist_tostr(states[1].resultlist)+' and '+biniplist_tostr(states[0].resultlist));\r
 192           biniplist_addlist(fresultlist,states[1].resultlist);\r
 193           biniplist_addlist(fresultlist,states[0].resultlist);\r
 194         end else begin\r
 195           //writeln('processing for two states, ipv4 preference');\r
 196           biniplist_addlist(fresultlist,states[0].resultlist);\r
 197           biniplist_addlist(fresultlist,states[1].resultlist);\r
 198         {$endif}\r
 199         end;\r
 200         //writeln(biniplist_tostr(fresultlist));\r
 201         onrequestdone(self,0);\r
 202       end;\r
 203     end;\r
 204     action_sendquery:begin\r
 205       sendquery(socketno,states[socketno].sendpacket,states[socketno].sendpacketlen);\r
 206     end;\r
 207   end;\r
 208 end;\r
 209 \r
 210 procedure tdnsasync.forwardlookup;\r
 211 var\r
 212   bip : tbinip;\r
 213   i : integer;\r
 214 begin\r
 215 \r
 216   ipstrtobin(name,bip);\r
 217 \r
 218   if bip.family <> 0 then begin\r
 219     // it was an IP address\r
 220     fresultlist := biniplist_new;\r
 221     biniplist_add(fresultlist,bip);\r
 222     onrequestdone(self,0);\r
 223     exit;\r
 224   end;\r
 225 \r
 226   if overrideaf = useaf_default then begin\r
 227     {$ifdef linux}{$ifdef ipv6}initpreferredmode;{$endif}{$endif}\r
 228     requestaf := useaf;\r
 229   end else begin\r
 230     requestaf := overrideaf;\r
 231   end;\r
 232 \r
 233   {$ifdef win32}\r
 234     if usewindns or (addr = '') then begin\r
 235       dwas := tdnswinasync.create;\r
 236       dwas.onrequestdone := winrequestdone;\r
 237       if forwardfamily = AF_INET6 then begin\r
 238         dwas.forwardlookup(name,true);\r
 239       end else begin\r
 240         dwas.forwardlookup(name,false);\r
 241       end;\r
 242       exit;\r
 243     end;\r
 244   {$endif}\r
 245 \r
 246   numsockused := 0;\r
 247   fresultlist := biniplist_new;\r
 248   if (requestaf <> useaf_v6) then begin\r
 249     setstate_forward(name,states[numsockused],af_inet);\r
 250     inc(numsockused);\r
 251   end;\r
 252 \r
 253   {$ifdef ipv6}\r
 254     if (requestaf <> useaf_v4) then begin\r
 255       setstate_forward(name,states[numsockused],af_inet6);\r
 256       inc(numsockused);\r
 257     end;\r
 258   {$endif}\r
 259   for i := 0 to numsockused-1 do begin\r
 260     asyncprocess(i);\r
 261   end;\r
 262 \r
 263 end;\r
 264 \r
 265 procedure tdnsasync.reverselookup;\r
 266 \r
 267 begin\r
 268   {$ifdef win32}\r
 269     if usewindns or (addr = '') then begin\r
 270       dwas := tdnswinasync.create;\r
 271       dwas.onrequestdone := winrequestdone;\r
 272       dwas.reverselookup(binip);\r
 273       exit;\r
 274     end;\r
 275   {$endif}\r
 276 \r
 277   setstate_reverse(binip,states[0]);\r
 278   numsockused := 1;\r
 279   asyncprocess(0);\r
 280 end;\r
 281 \r
 282 function tdnsasync.dnsresult;\r
 283 begin\r
 284   if states[0].resultstr <> '' then result := states[0].resultstr else begin\r
 285     result := ipbintostr(biniplist_get(fresultlist,0));\r
 286   end;\r
 287 end;\r
 288 \r
 289 procedure tdnsasync.dnsresultbin(var binip:tbinip);\r
 290 begin\r
 291   binip := biniplist_get(fresultlist,0);\r
 292 end;\r
 293 \r
 294 procedure tdnsasync.cancel;\r
 295 var\r
 296   socketno : integer;\r
 297 begin\r
 298   {$ifdef win32}\r
 299     if assigned(dwas) then begin\r
 300       dwas.release;\r
 301       dwas := nil;\r
 302     end else\r
 303   {$endif}\r
 304   begin\r
 305     for socketno := 0 to numsock-1 do begin\r
 306       reportlag(dnsserverids[socketno],-1);\r
 307       dnsserverids[socketno] := -1;\r
 308 \r
 309       sockets[socketno].close;\r
 310     end;\r
 311 \r
 312   end;\r
 313   for socketno := 0 to numsock-1 do begin\r
 314     setstate_failure(states[socketno]);\r
 315 \r
 316   end;\r
 317   fresultlist := biniplist_new;\r
 318   onrequestdone(self,0);\r
 319 end;\r
 320 \r
 321 {$ifdef win32}\r
 322   procedure tdnsasync.winrequestdone(sender:tobject;error:word);\r
 323  \r
 324   begin\r
 325     if dwas.reverse then begin \r
 326       states[0].resultstr := dwas.name;\r
 327     end else begin \r
 328 \r
 329       {$ifdef ipv6}\r
 330       if (requestaf = useaf_preferv4) then begin\r
 331         {prefer mode: sort the IP's}\r
 332         fresultlist := biniplist_new;\r
 333         addipsoffamily(fresultlist,dwas.iplist,af_inet);\r
 334         addipsoffamily(fresultlist,dwas.iplist,af_inet6);\r
 335 \r
 336       end else if (requestaf = useaf_preferv6) then begin\r
 337         {prefer mode: sort the IP's}\r
 338         fresultlist := biniplist_new;\r
 339         addipsoffamily(fresultlist,dwas.iplist,af_inet6);\r
 340         addipsoffamily(fresultlist,dwas.iplist,af_inet);\r
 341         \r
 342       end else\r
 343       {$endif}\r
 344       begin\r
 345         fresultlist := dwas.iplist;\r
 346       end;\r
 347 \r
 348     end;\r
 349     dwas.release;\r
 350     onrequestdone(self,error);\r
 351   end;\r
 352 {$endif}\r
 353 end.\r