X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/31d4361fb52761b6486f55af10268a51ee536a6f..64005e4a670ae074eea1980c5eca131748884ec0:/dnscore.pas diff --git a/dnscore.pas b/dnscore.pas index 18e40c9..e38f35f 100644 --- a/dnscore.pas +++ b/dnscore.pas @@ -6,12 +6,12 @@ { code wanting to use this dns system should act as follows (note: app - developers will probablly want to use dnsasync or dnssync or write a similar - wrapper unit of thier own). + developers will probably want to use dnsasync or dnssync or write a similar + wrapper unit of their own). for normal lookups call setstate_forward or setstate_reverse to set up the state, for more obscure lookups use setstate_request_init and fill in other - relavent state manually. + relevant state manually. call state_process which will do processing on the information in the state and return an action @@ -20,7 +20,7 @@ action_sendpacket means that dnscore wants the code that calls it to send the packet in sendpacket/sendpacketlen and then start (or go back to) listening for - action_done means the request has completed (either suceeded or failed) + action_done means the request has completed (either succeeded or failed) callers should resend the last packet they tried to send if they have not been asked to send a new packet for more than some timeout value they choose. @@ -32,23 +32,23 @@ following ways. on failure state.resultstr will be an empty string and state.resultbin will - be zeroed out (easilly detected by the fact that it will have a family of 0) + be zeroed out (easily detected by the fact that it will have a family of 0) on success for a A or AAAA lookup state.resultstr will be an empty string - and state.resultbin will contain the result (note: AAAA lookups require IPV6 + and state.resultbin will contain the result (note: AAAA lookups require IPv6 enabled). - if an A lookup fails and the code is built with ipv6 enabled then the code + if an A lookup fails and the code is built with IPv6 enabled then the code will return any AAAA records with the same name. The reverse does not apply - so if an application preffers IPV6 but wants IPV4 results as well it must - check them seperately. + so if an application prefers IPv6 but wants IPv4 results as well it must + check them separately. on success for any other type of lookup state.resultstr will be an empty note the state contains ansistrings, setstate_init with a null name parameter - can be used to clean theese up if required. + can be used to clean these up if required. - callers may use setstate_failure to mark the state as failed themseleves + callers may use setstate_failure to mark the state as failed themselves before passing it on to other code, for example this may be done in the event of a timeout. } @@ -62,7 +62,7 @@ interface uses binipstuff,classes,pgtypes,lcorernd; -var usewindns : boolean = {$ifdef win32}true{$else}false{$endif}; +var usewindns : boolean = {$ifdef mswindows}true{$else}false{$endif}; {hint to users of this unit that they should use windows dns instead. May be disabled by applications if desired. (e.g. if setting a custom dnsserverlist). @@ -106,7 +106,10 @@ const querytype_txt=16; querytype_spf=99; maxrecursion=50; - maxrrofakind=20; + maxrrofakind=32; + {the maximum number of RR of a kind of purely an extra sanity check and could be omitted. + before, i set it to 20, but valid replies can have more. dnscore only does udp requests, + and ordinary DNS, so up to 512 bytes. the maximum number of A records that fits seems to be 29} retryafter=300000; //microseconds must be less than one second; timeoutlag=1000000000; // penalty value to be treated as lag in the event of a timeout (microseconds) @@ -159,7 +162,7 @@ type end; //commenting out functions from interface that do not have documented semantics -//and probablly should not be called from outside this unit, reenable them +//and probably should not be called from outside this unit, reenable them //if you must but please document them at the same time --plugwash //function buildrequest(const name:string;var packet:tdnspacket;requesttype:word):integer; @@ -169,7 +172,7 @@ function makereversename(const binip:tbinip):ansistring; procedure setstate_request_init(const name:ansistring;var state:tdnsstate); -//set up state for a foward lookup. A family value of AF_INET6 will give only +//set up state for a forward lookup. A family value of AF_INET6 will give only //ipv6 results. Any other value will give only ipv4 results procedure setstate_forward(const name:ansistring;var state:tdnsstate;family:integer); @@ -188,7 +191,8 @@ procedure populatednsserverlist; procedure cleardnsservercache; var - dnsserverlist : tstringlist; + dnsserverlist : tbiniplist; + dnsserverlag:tlist; // currentdnsserverno : integer; @@ -196,6 +200,7 @@ var //id to the id of that nameserver. id should later be used to report how laggy //the servers response was and if it was timed out. function getcurrentsystemnameserver(var id:integer) :ansistring; +function getcurrentsystemnameserverbin(var id:integer) :tbinip; procedure reportlag(id:integer;lag:integer); //lag should be in microseconds and should be -1 to report a timeout //var @@ -219,9 +224,6 @@ function getquerytype(s:ansistring):integer; implementation uses - {$ifdef win32} - windows, - {$endif} lcorelocalips, sysutils; @@ -503,7 +505,10 @@ begin state.numrr2 := 0; for a := 0 to 3 do begin state.numrr1[a] := htons(state.recvpacket.rrcount[a]); - if state.numrr1[a] > maxrrofakind then goto failure; + if state.numrr1[a] > maxrrofakind then begin + failurereason := 'exceeded maximum RR of a kind'; + goto failure; + end; inc(state.numrr2,state.numrr1[a]); end; @@ -592,7 +597,7 @@ recursed: goto failure; end; - {do /ets/hosts lookup here} + {do /etc/hosts lookup here} state.sendpacketlen := buildrequest(state.queryname,state.sendpacket,state.requesttype); if state.sendpacketlen = 0 then begin failurereason := 'building request packet failed'; @@ -605,132 +610,59 @@ recursed: failure: setstate_failure(state); end; -{$ifdef win32} - const - MAX_HOSTNAME_LEN = 132; - MAX_DOMAIN_NAME_LEN = 132; - MAX_SCOPE_ID_LEN = 260 ; - MAX_ADAPTER_NAME_LENGTH = 260; - MAX_ADAPTER_ADDRESS_LENGTH = 8; - MAX_ADAPTER_DESCRIPTION_LENGTH = 132; - ERROR_BUFFER_OVERFLOW = 111; - MIB_IF_TYPE_ETHERNET = 6; - MIB_IF_TYPE_TOKENRING = 9; - MIB_IF_TYPE_FDDI = 15; - MIB_IF_TYPE_PPP = 23; - MIB_IF_TYPE_LOOPBACK = 24; - MIB_IF_TYPE_SLIP = 28; - - - type - tip_addr_string=packed record - Next :pointer; - IpAddress : array[0..15] of ansichar; - ipmask : array[0..15] of ansichar; - context : dword; - end; - pip_addr_string=^tip_addr_string; - tFIXED_INFO=packed record - HostName : array[0..MAX_HOSTNAME_LEN-1] of ansichar; - DomainName : array[0..MAX_DOMAIN_NAME_LEN-1] of ansichar; - currentdnsserver : pip_addr_string; - dnsserverlist : tip_addr_string; - nodetype : longint; - ScopeId : array[0..MAX_SCOPE_ID_LEN + 4] of ansichar; - enablerouting : longbool; - enableproxy : longbool; - enabledns : longbool; - end; - pFIXED_INFO=^tFIXED_INFO; - var - iphlpapi : thandle; - getnetworkparams : function(pFixedInfo : PFIXED_INFO;OutBufLen : plongint) : longint;stdcall; -{$endif} + procedure populatednsserverlist; var - {$ifdef win32} - fixed_info : pfixed_info; - fixed_info_len : longint; - currentdnsserver : pip_addr_string; - {$else} - t:textfile; - s:ansistring; - a:integer; - {$endif} + a:integer; begin - //result := ''; - if assigned(dnsserverlist) then begin - dnsserverlist.clear; + if assigned(dnsserverlag) then begin + dnsserverlag.clear; end else begin - dnsserverlist := tstringlist.Create; + dnsserverlag := tlist.Create; end; - {$ifdef win32} - if iphlpapi=0 then iphlpapi := loadlibrary('iphlpapi.dll'); - if not assigned(getnetworkparams) then @getnetworkparams := getprocaddress(iphlpapi,'GetNetworkParams'); - if not assigned(getnetworkparams) then exit; - fixed_info_len := 0; - if GetNetworkParams(nil,@fixed_info_len)<>ERROR_BUFFER_OVERFLOW then exit; - //fixed_info_len :=sizeof(tfixed_info); - getmem(fixed_info,fixed_info_len); - if GetNetworkParams(fixed_info,@fixed_info_len)<>0 then begin - freemem(fixed_info); - exit; - end; - currentdnsserver := @(fixed_info.dnsserverlist); - while assigned(currentdnsserver) do begin - dnsserverlist.Add(currentdnsserver.IpAddress); - currentdnsserver := currentdnsserver.next; - end; - freemem(fixed_info); - {$else} - filemode := 0; - assignfile(t,'/etc/resolv.conf'); - {$i-}reset(t);{$i+} - if ioresult <> 0 then exit; - - while not eof(t) do begin - readln(t,s); - if not (copy(s,1,10) = 'nameserver') then continue; - s := copy(s,11,500); - while s <> '' do begin - if (s[1] = #32) or (s[1] = #9) then s := copy(s,2,500) else break; - end; - a := pos(' ',s); - if a <> 0 then s := copy(s,1,a-1); - a := pos(#9,s); - if a <> 0 then s := copy(s,1,a-1); - //result := s; - //if result <> '' then break; - dnsserverlist.Add(s); - end; - close(t); - {$endif} + + dnsserverlist := getsystemdnsservers; + for a := biniplist_getcount(dnsserverlist)-1 downto 0 do dnsserverlag.Add(nil); end; procedure cleardnsservercache; begin - if assigned(dnsserverlist) then begin - dnsserverlist.destroy; - dnsserverlist := nil; + if assigned(dnsserverlag) then begin + dnsserverlag.destroy; + dnsserverlag := nil; + dnsserverlist := ''; end; end; -function getcurrentsystemnameserver(var id:integer):ansistring; +function getcurrentsystemnameserverbin(var id:integer):tbinip; var counter : integer; - begin - if not assigned(dnsserverlist) then populatednsserverlist; - if dnsserverlist.count=0 then raise exception.create('no dns servers availible'); - id := 0; - if dnsserverlist.count >1 then begin + {override the name server choice here, instead of overriding it wherever it's called + setting ID to -1 causes it to be ignored in reportlag} + if (overridednsserver <> '') then begin + result := ipstrtobinf(overridednsserver); + if result.family <> 0 then begin + id := -1; + exit; + end; + end; - for counter := 1 to dnsserverlist.count-1 do begin - if taddrint(dnsserverlist.objects[counter]) < taddrint(dnsserverlist.objects[id]) then id := counter; + if not assigned(dnsserverlag) then populatednsserverlist; + if dnsserverlag.count=0 then raise exception.create('no dns servers available'); + id := 0; + if dnsserverlag.count >1 then begin + for counter := dnsserverlag.count-1 downto 1 do begin + if taddrint(dnsserverlag[counter]) < taddrint(dnsserverlag[id]) then id := counter; end; end; - result := dnsserverlist[id] + result := biniplist_get(dnsserverlist,id); +end; + +function getcurrentsystemnameserver(var id:integer):ansistring; +begin + result := ipbintostr(getcurrentsystemnameserverbin(id)); end; procedure reportlag(id:integer;lag:integer); //lag should be in microseconds and should be -1 to report a timeout @@ -738,12 +670,12 @@ var counter : integer; temp : integer; begin - if (id < 0) or (id >= dnsserverlist.count) then exit; + if (id < 0) or (id >= dnsserverlag.count) then exit; if lag = -1 then lag := timeoutlag; - for counter := 0 to dnsserverlist.count-1 do begin - temp := taddrint(dnsserverlist.objects[counter]) *15; + for counter := 0 to dnsserverlag.count-1 do begin + temp := taddrint(dnsserverlag[counter]) *15; if counter=id then temp := temp + lag; - dnsserverlist.objects[counter] := tobject(temp div 16); + dnsserverlag[counter] := tobject(temp div 16); end; end;