123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394 |
- { Copyright (C) 2005 Bas Steendijk and Peter Green
- For conditions of distribution and use, see copyright notice in zlib_license.txt
- which is included in the package
- ----------------------------------------------------------------------------- }
-
- //FIXME: this code only ever seems to use one dns server for a request and does
- //not seem to have any form of retry code.
-
- unit dnsasync;
-
- interface
-
- uses
- {$ifdef win32}
- dnswin,
- {$endif}
- lsocket,lcore,
- classes,binipstuff,dnscore,btime,lcorernd;
-
- {$include lcoreconfig.inc}
-
- const
- numsock=1{$ifdef ipv6}+1{$endif};
-
- type
-
- //after completion or cancelation a dnswinasync may be reused
- tdnsasync=class(tcomponent)
-
- private
- //made a load of stuff private that does not appear to be part of the main
- //public interface. If you make any of it public again please consider the
- //consequences when using windows dns. --plugwash.
- sockets: array[0..numsock-1] of tlsocket;
-
- states: array[0..numsock-1] of tdnsstate;
-
- destinations: array[0..numsock-1] of tbinip;
-
- dnsserverids : array[0..numsock-1] of integer;
- startts:double;
- {$ifdef win32}
- dwas : tdnswinasync;
- {$endif}
-
- numsockused : integer;
- fresultlist : tbiniplist;
- requestaf : integer;
- procedure asyncprocess(socketno:integer);
- procedure receivehandler(sender:tobject;error:word);
- function sendquery(socketno:integer;const packet:tdnspacket;len:integer):boolean;
- {$ifdef win32}
- procedure winrequestdone(sender:tobject;error:word);
- {$endif}
-
- public
- onrequestdone:tsocketevent;
-
- //addr and port allow the application to specify a dns server specifically
- //for this dnsasync object. This is not a reccomended mode of operation
- //because it limits the app to one dns server but is kept for compatibility
- //and special uses.
- addr,port:string;
-
- overrideaf : integer;
-
- procedure cancel;//cancel an outstanding dns request
- function dnsresult:string; //get result of dnslookup as a string
- procedure dnsresultbin(var binip:tbinip); //get result of dnslookup as a tbinip
- property dnsresultlist : tbiniplist read fresultlist;
- procedure forwardlookup(const name:string); //start forward lookup,
- //preffering ipv4
- procedure reverselookup(const binip:tbinip); //start reverse lookup
- procedure customlookup(const name:string;querytype:integer); //start custom type lookup
-
- constructor create(aowner:tcomponent); override;
- destructor destroy; override;
-
- end;
-
- implementation
-
- uses sysutils;
-
- constructor tdnsasync.create;
- begin
- inherited create(aowner);
- dnsserverids[0] := -1;
- sockets[0] := twsocket.create(self);
- sockets[0].tag := 0;
- {$ifdef ipv6}
- dnsserverids[1] := -1;
- sockets[1] := twsocket.Create(self);
- sockets[1].tag := 1;
- {$endif}
- end;
-
- destructor tdnsasync.destroy;
- var
- socketno : integer;
- begin
- for socketno := 0 to numsock -1 do begin
- if dnsserverids[socketno] >= 0 then begin
- reportlag(dnsserverids[socketno],-1);
- dnsserverids[socketno] := -1;
- end;
- sockets[socketno].release;
- setstate_request_init('',states[socketno]);
- end;
- inherited destroy;
- end;
-
- procedure tdnsasync.receivehandler(sender:tobject;error:word);
- var
- socketno : integer;
- Src : TInetSockAddrV;
- SrcLen : Integer;
- fromip:tbinip;
- fromport:string;
- begin
- socketno := tlsocket(sender).tag;
- //writeln('got a reply on socket number ',socketno);
- fillchar(states[socketno].recvpacket,sizeof(states[socketno].recvpacket),0);
-
- SrcLen := SizeOf(Src);
- states[socketno].recvpacketlen := twsocket(sender).ReceiveFrom(@(states[socketno].recvpacket), SizeOf(states[socketno].recvpacket), Src, SrcLen);
-
- fromip := inaddrvtobinip(Src);
- fromport := inttostr(htons(src.InAddr.port));
-
- if ((not comparebinip(fromip,destinations[socketno])) or (fromport <> port)) then begin
- // writeln('dnsasync received from wrong IP:port ',ipbintostr(fromip),'#',fromport,', expected ',ipbintostr(destinations[socketno]),'#',port);
- exit;
- end;
-
- states[socketno].parsepacket := true;
- if states[socketno].resultaction <> action_done then begin
- //we ignore packets that come after we are done
- if dnsserverids[socketno] >= 0 then begin
- reportlag(dnsserverids[socketno],trunc((unixtimefloat-startts)*1000000));
- dnsserverids[socketno] := -1;
- end;
- { writeln('received reply');}
-
- asyncprocess(socketno);
- //writeln('processed it');
- end else begin
- //writeln('ignored it because request is done');
- end;
- end;
-
- function tdnsasync.sendquery(socketno:integer;const packet:tdnspacket;len:integer):boolean;
- var
- destination : string;
- inaddr : tinetsockaddrv;
- trytolisten:integer;
- begin
- { writeln('sendquery ',decodename(state.packet,state.packetlen,12,0,a),' ',state.requesttype);}
- //writeln('trying to send query on socket number ',socketno);
- result := false;
- if len = 0 then exit; {no packet}
- if sockets[socketno].state <> wsconnected then begin
- startts := unixtimefloat;
- if port = '' then port := '53';
- sockets[socketno].Proto := 'udp';
- sockets[socketno].ondataavailable := receivehandler;
-
- {we are going to bind on a random local port for the DNS request, against the kaminsky attack
- there is a small chance that we're trying to bind on an already used port, so retry a few times}
- for trytolisten := 3 downto 0 do begin
- try
- sockets[socketno].port := inttostr(1024 + randominteger(65536 - 1024));
- sockets[socketno].listen;
- except
- {writeln('failed to listen ',sockets[socketno].localport,' ',trytolisten);}
- if (trytolisten = 0) then begin
- result := false;
- exit;
- end;
- end;
- end;
-
- end;
- if addr <> '' then begin
- dnsserverids[socketno] := -1;
- destination := addr
- end else begin
- destination := getcurrentsystemnameserver(dnsserverids[socketno]);
- end;
- destinations[socketno] := ipstrtobinf(destination);
-
- {$ifdef ipv6}{$ifdef win32}
- if destinations[socketno].family = AF_INET6 then if (requestaf = useaf_default) then requestaf := useaf_preferv6;
- {$endif}{$endif}
-
- makeinaddrv(destinations[socketno],port,inaddr);
- sockets[socketno].sendto(inaddr,sizeof(inaddr), @packet,len);
- result := true;
-
-
- end;
-
- procedure tdnsasync.asyncprocess(socketno:integer);
- begin
- state_process(states[socketno]);
- case states[socketno].resultaction of
- action_ignore: begin {do nothing} end;
- action_done: begin
- {$ifdef ipv6}
- if (numsockused = 1) or (states[socketno xor 1].resultaction=action_done) then
- //if using two sockets we need to wait until both sockets are in the done
- //state before firing the event
- {$endif}
- begin
- fresultlist := biniplist_new;
- if (numsockused = 1) then begin
- //writeln('processing for one state');
- biniplist_addlist(fresultlist,states[0].resultlist);
- {$ifdef ipv6}
- end else if (requestaf = useaf_preferv6) then begin
- //writeln('processing for two states, ipv6 preference');
- //writeln('merging lists '+biniplist_tostr(states[1].resultlist)+' and '+biniplist_tostr(states[0].resultlist));
- biniplist_addlist(fresultlist,states[1].resultlist);
- biniplist_addlist(fresultlist,states[0].resultlist);
- end else begin
- //writeln('processing for two states, ipv4 preference');
- biniplist_addlist(fresultlist,states[0].resultlist);
- biniplist_addlist(fresultlist,states[1].resultlist);
- {$endif}
- end;
- //writeln(biniplist_tostr(fresultlist));
- onrequestdone(self,0);
- end;
- end;
- action_sendquery:begin
- sendquery(socketno,states[socketno].sendpacket,states[socketno].sendpacketlen);
- end;
- end;
- end;
-
- procedure tdnsasync.forwardlookup;
- var
- bip : tbinip;
- i : integer;
- begin
- ipstrtobin(name,bip);
-
- if bip.family <> 0 then begin
- // it was an IP address
- fresultlist := biniplist_new;
- biniplist_add(fresultlist,bip);
- onrequestdone(self,0);
- exit;
- end;
-
- if (overridednsserver <> '') and (addr = '') then addr := overridednsserver;
-
- if overrideaf = useaf_default then begin
- {$ifdef ipv6}
- {$ifdef win32}if not (usewindns and (addr = '')) then{$endif}
- initpreferredmode;
- {$endif}
- requestaf := useaf;
- end else begin
- requestaf := overrideaf;
- end;
-
- {$ifdef win32}
- if usewindns and (addr = '') then begin
- dwas := tdnswinasync.create;
- dwas.onrequestdone := winrequestdone;
-
- dwas.forwardlookup(name);
-
- exit;
- end;
- {$endif}
-
- numsockused := 0;
- fresultlist := biniplist_new;
- if (requestaf <> useaf_v6) then begin
- setstate_forward(name,states[numsockused],af_inet);
- inc(numsockused);
- end;
-
- {$ifdef ipv6}
- if (requestaf <> useaf_v4) then begin
- setstate_forward(name,states[numsockused],af_inet6);
- inc(numsockused);
- end;
- {$endif}
- for i := 0 to numsockused-1 do begin
- asyncprocess(i);
- end;
-
- end;
-
- procedure tdnsasync.reverselookup;
- begin
- if (overridednsserver <> '') and (addr = '') then addr := overridednsserver;
- {$ifdef win32}
- if usewindns and (addr = '') then begin
- dwas := tdnswinasync.create;
- dwas.onrequestdone := winrequestdone;
- dwas.reverselookup(binip);
- exit;
- end;
- {$endif}
-
- setstate_reverse(binip,states[0]);
- numsockused := 1;
- asyncprocess(0);
- end;
-
- procedure tdnsasync.customlookup;
- begin
- if (overridednsserver <> '') and (addr = '') then addr := overridednsserver;
- setstate_custom(name,querytype,states[0]);
- numsockused := 1;
- asyncprocess(0);
- end;
-
- function tdnsasync.dnsresult;
- begin
- if states[0].resultstr <> '' then result := states[0].resultstr else begin
- result := ipbintostr(biniplist_get(fresultlist,0));
- end;
- end;
-
- procedure tdnsasync.dnsresultbin(var binip:tbinip);
- begin
- binip := biniplist_get(fresultlist,0);
- end;
-
- procedure tdnsasync.cancel;
- var
- socketno : integer;
- begin
- {$ifdef win32}
- if assigned(dwas) then begin
- dwas.release;
- dwas := nil;
- end else
- {$endif}
- begin
- for socketno := 0 to numsock-1 do begin
- reportlag(dnsserverids[socketno],-1);
- dnsserverids[socketno] := -1;
-
- sockets[socketno].close;
- end;
-
- end;
- for socketno := 0 to numsock-1 do begin
- setstate_failure(states[socketno]);
-
- end;
- fresultlist := biniplist_new;
- onrequestdone(self,0);
- end;
-
- {$ifdef win32}
- procedure tdnsasync.winrequestdone(sender:tobject;error:word);
-
- begin
- if dwas.reverse then begin
- states[0].resultstr := dwas.name;
- end else begin
-
- {$ifdef ipv6}
- if (requestaf = useaf_preferv4) then begin
- {prefer mode: sort the IP's}
- fresultlist := biniplist_new;
- addipsoffamily(fresultlist,dwas.iplist,af_inet);
- addipsoffamily(fresultlist,dwas.iplist,af_inet6);
-
- end else if (requestaf = useaf_preferv6) then begin
- {prefer mode: sort the IP's}
- fresultlist := biniplist_new;
- addipsoffamily(fresultlist,dwas.iplist,af_inet6);
- addipsoffamily(fresultlist,dwas.iplist,af_inet);
-
- end else
- {$endif}
- begin
- fresultlist := dwas.iplist;
- end;
-
- end;
- dwas.release;
- onrequestdone(self,error);
- end;
- {$endif}
- end.
|