\r
function tdnsasync.sendquery(socketno:integer;const packet:tdnspacket;len:integer):boolean;\r
var\r
- destination : ansistring;\r
+ destination : tbinip;\r
inaddr : tinetsockaddrv;\r
trytolisten:integer;\r
begin\r
end;\r
if addr <> '' then begin\r
dnsserverids[socketno] := -1;\r
- destination := addr\r
+ destination := ipstrtobinf(addr);\r
end else begin\r
- destination := getcurrentsystemnameserver(dnsserverids[socketno]);\r
+ destination := getcurrentsystemnameserverbin(dnsserverids[socketno]);\r
end;\r
- destinations[socketno] := ipstrtobinf(destination);\r
+ destinations[socketno] := destination;\r
\r
{$ifdef ipv6}{$ifdef win32}\r
if destinations[socketno].family = AF_INET6 then if (requestaf = useaf_default) then requestaf := useaf_preferv6;\r
exit;\r
end;\r
\r
- if (overridednsserver <> '') and (addr = '') then addr := overridednsserver;\r
-\r
if overrideaf = useaf_default then begin\r
{$ifdef ipv6}\r
{$ifdef win32}if not (usewindns and (addr = '')) then{$endif}\r
\r
procedure tdnsasync.reverselookup;\r
begin\r
- if (overridednsserver <> '') and (addr = '') then addr := overridednsserver;\r
{$ifdef win32}\r
if usewindns and (addr = '') then begin\r
dwas := tdnswinasync.create;\r
\r
procedure tdnsasync.customlookup;\r
begin\r
- if (overridednsserver <> '') and (addr = '') then addr := overridednsserver;\r
setstate_custom(name,querytype,states[0]);\r
numsockused := 1;\r
asyncprocess(0);\r
procedure cleardnsservercache;\r
\r
var\r
- dnsserverlist : tstringlist;\r
+ dnsserverlist : tbiniplist;\r
+ dnsserverlag:tlist;\r
// currentdnsserverno : integer;\r
\r
\r
//id to the id of that nameserver. id should later be used to report how laggy\r
//the servers response was and if it was timed out.\r
function getcurrentsystemnameserver(var id:integer) :ansistring;\r
+function getcurrentsystemnameserverbin(var id:integer) :tbinip;\r
procedure reportlag(id:integer;lag:integer); //lag should be in microseconds and should be -1 to report a timeout\r
\r
//var\r
implementation\r
\r
uses\r
- {$ifdef win32}\r
- windows,\r
- {$endif}\r
lcorelocalips,\r
sysutils;\r
\r
failure:\r
setstate_failure(state);\r
end;\r
-{$ifdef win32}\r
- const\r
- MAX_HOSTNAME_LEN = 132;\r
- MAX_DOMAIN_NAME_LEN = 132;\r
- MAX_SCOPE_ID_LEN = 260 ;\r
- MAX_ADAPTER_NAME_LENGTH = 260;\r
- MAX_ADAPTER_ADDRESS_LENGTH = 8;\r
- MAX_ADAPTER_DESCRIPTION_LENGTH = 132;\r
- ERROR_BUFFER_OVERFLOW = 111;\r
- MIB_IF_TYPE_ETHERNET = 6;\r
- MIB_IF_TYPE_TOKENRING = 9;\r
- MIB_IF_TYPE_FDDI = 15;\r
- MIB_IF_TYPE_PPP = 23;\r
- MIB_IF_TYPE_LOOPBACK = 24;\r
- MIB_IF_TYPE_SLIP = 28;\r
-\r
-\r
- type\r
- tip_addr_string=packed record\r
- Next :pointer;\r
- IpAddress : array[0..15] of ansichar;\r
- ipmask : array[0..15] of ansichar;\r
- context : dword;\r
- end;\r
- pip_addr_string=^tip_addr_string;\r
- tFIXED_INFO=packed record\r
- HostName : array[0..MAX_HOSTNAME_LEN-1] of ansichar;\r
- DomainName : array[0..MAX_DOMAIN_NAME_LEN-1] of ansichar;\r
- currentdnsserver : pip_addr_string;\r
- dnsserverlist : tip_addr_string;\r
- nodetype : longint;\r
- ScopeId : array[0..MAX_SCOPE_ID_LEN + 4] of ansichar;\r
- enablerouting : longbool;\r
- enableproxy : longbool;\r
- enabledns : longbool;\r
- end;\r
- pFIXED_INFO=^tFIXED_INFO;\r
\r
- var\r
- iphlpapi : thandle;\r
- getnetworkparams : function(pFixedInfo : PFIXED_INFO;OutBufLen : plongint) : longint;stdcall;\r
-{$endif}\r
+\r
procedure populatednsserverlist;\r
var\r
- {$ifdef win32}\r
- fixed_info : pfixed_info;\r
- fixed_info_len : longint;\r
- currentdnsserver : pip_addr_string;\r
- {$else}\r
- t:textfile;\r
- s:ansistring;\r
- a:integer;\r
- {$endif}\r
+ a:integer;\r
begin\r
- //result := '';\r
- if assigned(dnsserverlist) then begin\r
- dnsserverlist.clear;\r
+ if assigned(dnsserverlag) then begin\r
+ dnsserverlag.clear;\r
end else begin\r
- dnsserverlist := tstringlist.Create;\r
+ dnsserverlag := tlist.Create;\r
end;\r
- {$ifdef win32}\r
- if iphlpapi=0 then iphlpapi := loadlibrary('iphlpapi.dll');\r
- if not assigned(getnetworkparams) then @getnetworkparams := getprocaddress(iphlpapi,'GetNetworkParams');\r
- if not assigned(getnetworkparams) then exit;\r
- fixed_info_len := 0;\r
- if GetNetworkParams(nil,@fixed_info_len)<>ERROR_BUFFER_OVERFLOW then exit;\r
- //fixed_info_len :=sizeof(tfixed_info);\r
- getmem(fixed_info,fixed_info_len);\r
- if GetNetworkParams(fixed_info,@fixed_info_len)<>0 then begin\r
- freemem(fixed_info);\r
- exit;\r
- end;\r
- currentdnsserver := @(fixed_info.dnsserverlist);\r
- while assigned(currentdnsserver) do begin\r
- dnsserverlist.Add(currentdnsserver.IpAddress);\r
- currentdnsserver := currentdnsserver.next;\r
- end;\r
- freemem(fixed_info);\r
- {$else}\r
- filemode := 0;\r
- assignfile(t,'/etc/resolv.conf');\r
- {$i-}reset(t);{$i+}\r
- if ioresult <> 0 then exit;\r
-\r
- while not eof(t) do begin\r
- readln(t,s);\r
- if not (copy(s,1,10) = 'nameserver') then continue;\r
- s := copy(s,11,500);\r
- while s <> '' do begin\r
- if (s[1] = #32) or (s[1] = #9) then s := copy(s,2,500) else break;\r
- end;\r
- a := pos(' ',s);\r
- if a <> 0 then s := copy(s,1,a-1);\r
- a := pos(#9,s);\r
- if a <> 0 then s := copy(s,1,a-1);\r
- //result := s;\r
- //if result <> '' then break;\r
- dnsserverlist.Add(s);\r
- end;\r
- close(t);\r
- {$endif}\r
+\r
+ dnsserverlist := getsystemdnsservers;\r
+ for a := biniplist_getcount(dnsserverlist)-1 downto 0 do dnsserverlag.Add(nil);\r
end;\r
\r
procedure cleardnsservercache;\r
begin\r
- if assigned(dnsserverlist) then begin\r
- dnsserverlist.destroy;\r
- dnsserverlist := nil;\r
+ if assigned(dnsserverlag) then begin\r
+ dnsserverlag.destroy;\r
+ dnsserverlag := nil;\r
+ dnsserverlist := '';\r
end;\r
end;\r
\r
-function getcurrentsystemnameserver(var id:integer):ansistring;\r
+function getcurrentsystemnameserverbin(var id:integer):tbinip;\r
var\r
counter : integer;\r
-\r
begin\r
- if not assigned(dnsserverlist) then populatednsserverlist;\r
- if dnsserverlist.count=0 then raise exception.create('no dns servers availible');\r
- id := 0;\r
- if dnsserverlist.count >1 then begin\r
+ {override the name server choice here, instead of overriding it whereever it's called\r
+ setting ID to -1 causes it to be ignored in reportlag}\r
+ if (overridednsserver <> '') then begin\r
+ result := ipstrtobinf(overridednsserver);\r
+ if result.family <> 0 then begin\r
+ id := -1;\r
+ exit;\r
+ end;\r
+ end;\r
\r
- for counter := 1 to dnsserverlist.count-1 do begin\r
- if taddrint(dnsserverlist.objects[counter]) < taddrint(dnsserverlist.objects[id]) then id := counter;\r
+ if not assigned(dnsserverlag) then populatednsserverlist;\r
+ if dnsserverlag.count=0 then raise exception.create('no dns servers availible');\r
+ id := 0;\r
+ if dnsserverlag.count >1 then begin\r
+ for counter := dnsserverlag.count-1 downto 1 do begin\r
+ if taddrint(dnsserverlag[counter]) < taddrint(dnsserverlag[id]) then id := counter;\r
end;\r
end;\r
- result := dnsserverlist[id]\r
+ result := biniplist_get(dnsserverlist,id);\r
+end;\r
+\r
+function getcurrentsystemnameserver(var id:integer):ansistring;\r
+begin\r
+ result := ipbintostr(getcurrentsystemnameserverbin(id));\r
end;\r
\r
procedure reportlag(id:integer;lag:integer); //lag should be in microseconds and should be -1 to report a timeout\r
counter : integer;\r
temp : integer;\r
begin\r
- if (id < 0) or (id >= dnsserverlist.count) then exit;\r
+ if (id < 0) or (id >= dnsserverlag.count) then exit;\r
if lag = -1 then lag := timeoutlag;\r
- for counter := 0 to dnsserverlist.count-1 do begin\r
- temp := taddrint(dnsserverlist.objects[counter]) *15;\r
+ for counter := 0 to dnsserverlag.count-1 do begin\r
+ temp := taddrint(dnsserverlag[counter]) *15;\r
if counter=id then temp := temp + lag;\r
- dnsserverlist.objects[counter] := tobject(temp div 16);\r
+ dnsserverlag[counter] := tobject(temp div 16);\r
end;\r
\r
end;\r
\r
function sendquery(socknum:integer;const packet:tdnspacket;len:integer):boolean;\r
var\r
- addr : ansistring;\r
+ ip : tbinip;\r
port : ansistring;\r
inaddr : TInetSockAddrV;\r
begin\r
result := false;\r
if len = 0 then exit; {no packet}\r
\r
- if overridednsserver <> '' then addr := overridednsserver else addr := getcurrentsystemnameserver(id);\r
+ ip := getcurrentsystemnameserverbin(id);\r
\r
{$ifdef ipv6}{$ifdef win32}\r
if toaddr[socknum].family = AF_INET6 then if (useaf = 0) then useaf := useaf_preferv6;\r
{$endif}{$endif}\r
\r
port := toport;\r
- toaddr[socknum] := ipstrtobinf(addr);\r
+ toaddr[socknum] := ip;\r
makeinaddrv(toaddr[socknum],port,inaddr);\r
\r
sendto(fd[socknum],packet,len,0,inaddr,inaddrsize(inaddr));\r
inAddrtemp : TInetSockAddrV;\r
a:integer;\r
biniptemp:tbinip;\r
- addr:ansistring;\r
+\r
begin\r
//init both sockets smultaneously, always, so they get succesive fd's\r
if fd[0] > 0 then exit;\r
\r
- if overridednsserver <> '' then addr := overridednsserver else addr := getcurrentsystemnameserver(id);\r
+ biniptemp := getcurrentsystemnameserverbin(id);\r
//must get the DNS server here so we know to init v4 or v6\r
\r
- ipstrtobin(addr,biniptemp);\r
-\r
if biniptemp.family = AF_INET6 then biniptemp := ipstrtobinf('::') else biniptemp := ipstrtobinf('0.0.0.0');\r
\r
\r
fillchar(state[socknum].recvpacket,sizeof(state[socknum].recvpacket),0);\r
msectotimeval(lag,(currenttime-sendquerytime[socknum]) and tsmask);\r
\r
- if overridednsserver = '' then reportlag(id,(lag.tv_sec*1000000)+lag.tv_usec);\r
+ reportlag(id,(lag.tv_sec*1000000)+lag.tv_usec);\r
\r
SrcLen := SizeOf(Src);\r
state[socknum].recvpacketlen := recvfrom(fd[socknum],state[socknum].recvpacket, SizeOf(state[socknum].recvpacket),0,Srcx,SrcLen);\r
\r
currenttime := getts;\r
\r
- if overridednsserver = '' then reportlag(id,-1);\r
+ reportlag(id,-1);\r
if (currenttime >= endtime) and ((not wrapmode) or (currenttime < starttime)) then begin\r
exit;\r
end else begin\r
----------------------------------------------------------------------------- }
{
-unit to get IP addresses assigned to local interfaces.
+unit to get various local system config
+
+
+- get IP addresses assigned to local interfaces.
both IPv4 and IPv6, or one address family in isolation.
works on both windows and linux.
an app that doesn't want link local IPs has to filter them out.
windows XP returns only one, global scope, v6 IP, due to shortcomings.
+
+
+- get system DNS servers
+
+- get system hostname
+
}
unit lcorelocalips;
function getv6localips:tbiniplist;
{$endif}
+function getsystemdnsservers:tbiniplist;
+function getsystemhostname:ansistring;
+
implementation
{$ifdef linux}
{$else}
uses
- sysutils,winsock,dnssync;
+ sysutils,windows,winsock,dnssync;
{the following code's purpose is to determine what IP windows would come from, to reach an IP
it can be abused to find if there's any global v6 IPs on a local interface}
+
+
+{$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;
+
+function callGetNetworkParams:pFIXED_INFO;
+var
+ fixed_info : pfixed_info;
+ fixed_info_len : longint;
+begin
+ result := nil;
+ 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;
+ result := fixed_info;
+end;
+
+{$endif}
+
+function getsystemdnsservers:tbiniplist;
+var
+ {$ifdef win32}
+ fixed_info : pfixed_info;
+ currentdnsserver : pip_addr_string;
+ {$else}
+ t:textfile;
+ s:ansistring;
+ a:integer;
+ {$endif}
+ ip:tbinip;
+begin
+ //result := '';
+
+ result := biniplist_new;
+
+ {$ifdef win32}
+ fixed_info := callgetnetworkparams;
+ if fixed_info = nil then exit;
+
+ currentdnsserver := @(fixed_info.dnsserverlist);
+ while assigned(currentdnsserver) do begin
+ ip := ipstrtobinf(currentdnsserver.IpAddress);
+ if (ip.family <> 0) then biniplist_add(result,ip);
+ 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);
+
+ ip := ipstrtobinf(s);
+ if (ip.family <> 0) then biniplist_add(result,ip);
+ end;
+ closefile(t);
+ {$endif}
+end;
+
+
+function getsystemhostname:ansistring;
+var
+ {$ifdef win32}
+ fixed_info : pfixed_info;
+ {$else}
+ t:textfile;
+ {$endif}
+begin
+ result := '';
+ {$ifdef win32}
+ fixed_info := callgetnetworkparams;
+ if fixed_info = nil then exit;
+
+ result := fixed_info.hostname;
+ if fixed_info.domainname <> '' then result := result + '.'+fixed_info.domainname;
+
+ freemem(fixed_info);
+ {$else}
+ filemode := 0;
+ assignfile(t,'/etc/hostname');
+ {$i-}reset(t);{$i+}
+ if ioresult <> 0 then exit;
+ readln(t,result);
+ closefile(t);
+ {$endif}
+end;
+
end.
lcore.org gitweb / lcore.git / commitdiff