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 \r
  21 type\r
  22   //after completion or cancelation a dnswinasync may be reused\r
  23   tdnsasync=class(tcomponent)\r
  24 \r
  25   private\r
  26     //made a load of stuff private that does not appear to be part of the main\r
  27     //public interface. If you make any of it public again please consider the\r
  28     //consequences when using windows dns. --plugwash.\r
  29     sock:twsocket;\r
  30 \r
  31     sockopen:boolean;\r
  32 \r
  33 \r
  34     state:tdnsstate;\r
  35 \r
  36     dnsserverid:integer;\r
  37     startts:double;\r
  38     {$ifdef win32}\r
  39       dwas : tdnswinasync;\r
  40     {$endif}\r
  41 \r
  42 \r
  43     procedure asyncprocess;\r
  44     procedure receivehandler(sender:tobject;error:word);\r
  45     function sendquery(const packet:tdnspacket;len:integer):boolean;\r
  46     {$ifdef win32}\r
  47       procedure winrequestdone(sender:tobject;error:word);\r
  48     {$endif}\r
  49   public\r
  50     onrequestdone:tsocketevent;\r
  51 \r
  52     //addr and port allow the application to specify a dns server specifically\r
  53     //for this dnsasync object. This is not a reccomended mode of operation\r
  54     //because it limits the app to one dns server but is kept for compatibility\r
  55     //and special uses.\r
  56     addr,port:string;\r
  57 \r
  58     //A family value of AF_INET6 will give only\r
  59     //ipv6 results. Any other value will give ipv4 results in preference and ipv6\r
  60     //results if ipv4 results are not available;\r
  61     forwardfamily:integer;\r
  62 \r
  63     procedure cancel;//cancel an outstanding dns request\r
  64     function dnsresult:string; //get result of dnslookup as a string\r
  65     procedure dnsresultbin(var binip:tbinip); //get result of dnslookup as a tbinip\r
  66     procedure forwardlookup(const name:string); //start forward lookup,\r
  67                                                 //preffering ipv4\r
  68     procedure reverselookup(const binip:tbinip); //start reverse lookup\r
  69 \r
  70     constructor create(aowner:tcomponent); override;\r
  71     destructor destroy; override;\r
  72 \r
  73   end;\r
  74 \r
  75 implementation\r
  76 \r
  77 uses sysutils;\r
  78 \r
  79 constructor tdnsasync.create;\r
  80 begin\r
  81   inherited create(aowner);\r
  82   dnsserverid := -1;\r
  83   sock := twsocket.create(self);\r
  84 end;\r
  85 \r
  86 destructor tdnsasync.destroy;\r
  87 begin\r
  88   if dnsserverid >= 0 then begin\r
  89     reportlag(dnsserverid,-1);\r
  90     dnsserverid := -1;\r
  91   end;\r
  92   sock.release;\r
  93   setstate_request_init('',state);\r
  94   inherited destroy;\r
  95 end;\r
  96 \r
  97 procedure tdnsasync.receivehandler;\r
  98 begin\r
  99   if dnsserverid >= 0 then begin\r
 100     reportlag(dnsserverid,trunc((unixtimefloat-startts)*1000));\r
 101     dnsserverid := -1;\r
 102   end;\r
 103 {  writeln('received reply');}\r
 104   fillchar(state.recvpacket,sizeof(state.recvpacket),0);\r
 105   state.recvpacketlen := twsocket(sender).Receive(@state.recvpacket, SizeOf(state.recvpacket));\r
 106   state.parsepacket := true;\r
 107   asyncprocess;\r
 108 end;\r
 109 \r
 110 function tdnsasync.sendquery;\r
 111 begin\r
 112 {  writeln('sendquery ',decodename(state.packet,state.packetlen,12,0,a),' ',state.requesttype);}\r
 113   result := false;\r
 114   if len = 0 then exit; {no packet}\r
 115   if not sockopen then begin\r
 116     if addr <> '' then sock.addr := addr else sock.addr := getcurrentsystemnameserver(dnsserverid);//getunixnameservercached;\r
 117     startts := unixtimefloat;\r
 118     if port = '' then port := '53';\r
 119     sock.port := port;\r
 120     sock.Proto := 'udp';\r
 121     sock.ondataavailable := receivehandler;\r
 122     try\r
 123       sock.connect;\r
 124     except\r
 125       on e:exception do begin\r
 126         //writeln('exception '+e.message);\r
 127         exit;\r
 128       end;\r
 129     end;\r
 130     sockopen := true;\r
 131   end;\r
 132   sock.send(@packet,len);\r
 133   result := true;\r
 134 end;\r
 135 \r
 136 procedure tdnsasync.asyncprocess;\r
 137 begin\r
 138   state_process(state);\r
 139   case state.resultaction of\r
 140     action_ignore: begin {do nothing} end;\r
 141     action_done: begin\r
 142       onrequestdone(self,0);\r
 143     end;\r
 144     action_sendquery:begin\r
 145       sendquery(state.sendpacket,state.sendpacketlen);\r
 146     end;\r
 147   end;\r
 148 end;\r
 149 \r
 150 procedure tdnsasync.forwardlookup;\r
 151 begin\r
 152 \r
 153   ipstrtobin(name,state.resultbin);\r
 154 \r
 155   {$ifdef win32}\r
 156     if usewindns or (addr = '') then begin\r
 157       dwas := tdnswinasync.create;\r
 158       dwas.onrequestdone := winrequestdone;\r
 159       if forwardfamily = AF_INET6 then begin\r
 160         dwas.forwardlookup(name,true);\r
 161       end else begin\r
 162         dwas.forwardlookup(name,false);\r
 163       end;\r
 164       exit;\r
 165     end;\r
 166   {$endif}\r
 167 \r
 168 \r
 169   if state.resultbin.family <> 0 then begin\r
 170     onrequestdone(self,0);\r
 171     exit;\r
 172   end;\r
 173 \r
 174 \r
 175   setstate_forward(name,state,forwardfamily);\r
 176   asyncprocess;\r
 177 \r
 178 end;\r
 179 \r
 180 procedure tdnsasync.reverselookup;\r
 181 \r
 182 begin\r
 183   {$ifdef win32}\r
 184     if usewindns or (addr = '') then begin\r
 185       dwas := tdnswinasync.create;\r
 186       dwas.onrequestdone := winrequestdone;\r
 187       dwas.reverselookup(binip);\r
 188       exit;\r
 189     end;\r
 190   {$endif}\r
 191 \r
 192   setstate_reverse(binip,state);\r
 193   asyncprocess;\r
 194 end;\r
 195 \r
 196 function tdnsasync.dnsresult;\r
 197 begin\r
 198   if state.resultstr <> '' then result := state.resultstr else begin\r
 199     result := ipbintostr(state.resultbin);\r
 200   end;\r
 201 end;\r
 202 \r
 203 procedure tdnsasync.dnsresultbin(var binip:tbinip);\r
 204 begin\r
 205   move(state.resultbin,binip,sizeof(binip));\r
 206 end;\r
 207 \r
 208 procedure tdnsasync.cancel;\r
 209 begin\r
 210   {$ifdef win32}\r
 211     if assigned(dwas) then begin\r
 212       dwas.release;\r
 213       dwas := nil;\r
 214     end else \r
 215   {$endif}\r
 216   begin\r
 217 \r
 218     if dnsserverid >= 0 then begin\r
 219       reportlag(dnsserverid,-1);\r
 220       dnsserverid := -1;\r
 221     end;\r
 222     if sockopen then begin\r
 223       sock.close;\r
 224       sockopen := false;\r
 225     end;\r
 226   end;\r
 227   setstate_failure(state);\r
 228   onrequestdone(self,0);\r
 229 end;\r
 230 \r
 231 {$ifdef win32}\r
 232   procedure tdnsasync.winrequestdone(sender:tobject;error:word);\r
 233  \r
 234   begin\r
 235     if dwas.reverse then begin \r
 236       state.resultstr := dwas.name;\r
 237     end else begin \r
 238       state.resultbin := dwas.ip;\r
 239       if (forwardfamily = AF_INET6) and (state.resultbin.family = AF_INET) then begin\r
 240         fillchar(state.resultbin,sizeof(tbinip),0);\r
 241       end;\r
 242     end;\r
 243     dwas.release;\r
 244     onrequestdone(self,error);\r
 245   end;\r
 246 {$endif}\r
 247 end.\r