mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-06-05 15:18:32 +02:00
+ Initial implementation
This commit is contained in:
michael
parent
ebf5a80eab
commit
3eaf4dbad2
1322
packages/base/netdb/Makefile
Normal file
1322
packages/base/netdb/Makefile
Normal file
File diff suppressed because it is too large
Load Diff
19
packages/base/netdb/Makefile.fpc
Normal file
19
packages/base/netdb/Makefile.fpc
Normal file
@ -0,0 +1,19 @@
|
||||
#
|
||||
# Makefile.fpc for netdb implementation
|
||||
#
|
||||
|
||||
[package]
|
||||
name=netdb
|
||||
version=1.0.6
|
||||
|
||||
[target]
|
||||
units=netdb
|
||||
examples=testdns testhst testsvc testnet
|
||||
|
||||
[require]
|
||||
|
||||
[install]
|
||||
fpcpackage=y
|
||||
|
||||
[default]
|
||||
fpcdir=../../..
|
||||
17
packages/base/netdb/README
Normal file
17
packages/base/netdb/README
Normal file
@ -0,0 +1,17 @@
|
||||
This directory contains a pure-pascal netdb implementation:
|
||||
It is written mainly to be able to implement network applications that
|
||||
do hostname lookups independent of the C library.
|
||||
|
||||
This provides the equivalent of the Inet unit, but the implementation is
|
||||
written completely in pascal. It parses the hosts,services and networks
|
||||
files just as the C library does (it should, anyway).
|
||||
|
||||
The DNS routines also do a DNS lookup and parse /etc/resolv.conf
|
||||
The 'domain' and 'search' entries in this file are parsed, but ignored.
|
||||
Only the 'nameserver' entries are used at the moment.
|
||||
|
||||
The various test programs show how to use this.
|
||||
|
||||
Enjoy!
|
||||
|
||||
Michael.
|
||||
109
packages/base/netdb/hs.inc
Normal file
109
packages/base/netdb/hs.inc
Normal file
@ -0,0 +1,109 @@
|
||||
|
||||
function HostAddrToStr (Entry : THostAddr) : String;
|
||||
|
||||
Var Dummy : String[4];
|
||||
I : Longint;
|
||||
|
||||
begin
|
||||
HostAddrToStr:='';
|
||||
For I:=1 to 4 do
|
||||
begin
|
||||
Str(Entry[I],Dummy);
|
||||
HostAddrToStr:=HostAddrToStr+Dummy;
|
||||
If I<4 Then
|
||||
HostAddrToStr:=HostAddrToStr+'.';
|
||||
end;
|
||||
end;
|
||||
|
||||
function StrToHostAddr(IP : String) : THostAddr ;
|
||||
|
||||
Var
|
||||
Dummy : String;
|
||||
I : Longint;
|
||||
J : Integer;
|
||||
Temp : THostAddr;
|
||||
|
||||
begin
|
||||
Result:=NoAddress;
|
||||
For I:=1 to 4 do
|
||||
begin
|
||||
If I<4 Then
|
||||
begin
|
||||
J:=Pos('.',IP);
|
||||
If J=0 then
|
||||
exit;
|
||||
Dummy:=Copy(IP,1,J-1);
|
||||
Delete (IP,1,J);
|
||||
end
|
||||
else
|
||||
Dummy:=IP;
|
||||
Val (Dummy,Temp[I],J);
|
||||
If J<>0 then Exit;
|
||||
end;
|
||||
Result:=Temp;
|
||||
end;
|
||||
|
||||
function NetAddrToStr (Entry : TNetAddr) : String;
|
||||
|
||||
Var Dummy : String[4];
|
||||
I : Longint;
|
||||
|
||||
begin
|
||||
NetAddrToStr:='';
|
||||
For I:=4 downto 1 do
|
||||
begin
|
||||
Str(Entry[I],Dummy);
|
||||
NetAddrToStr:=NetAddrToStr+Dummy;
|
||||
If I>1 Then
|
||||
NetAddrToStr:=NetAddrToStr+'.';
|
||||
end;
|
||||
end;
|
||||
|
||||
function StrToNetAddr(IP : String) : TNetAddr;
|
||||
|
||||
begin
|
||||
StrToNetAddr:=TNetAddr(StrToHostAddr(IP));
|
||||
end;
|
||||
|
||||
Function HostToNet (Host : ThostAddr) : THostAddr;
|
||||
|
||||
begin
|
||||
Result[1]:=Host[4];
|
||||
Result[2]:=Host[3];
|
||||
Result[3]:=Host[2];
|
||||
Result[4]:=Host[1];
|
||||
end;
|
||||
|
||||
Function NetToHost (Net : TNetAddr) : TNetAddr;
|
||||
|
||||
begin
|
||||
Result[1]:=Net[4];
|
||||
Result[2]:=Net[3];
|
||||
Result[3]:=Net[2];
|
||||
Result[4]:=Net[1];
|
||||
end;
|
||||
|
||||
Function HostToNet (Host : Longint) : Longint;
|
||||
|
||||
begin
|
||||
Result:=Longint(HostToNet(THostAddr(host)));
|
||||
end;
|
||||
|
||||
Function NetToHost (Net : Longint) : Longint;
|
||||
|
||||
begin
|
||||
Result:=Longint(NetToHost(TNetAddr(Net)));
|
||||
end;
|
||||
|
||||
Function ShortHostToNet (Host : Word) : Word;
|
||||
|
||||
begin
|
||||
ShortHostToNet:=lo(host)*256+Hi(Host);
|
||||
end;
|
||||
|
||||
Function ShortNetToHost (Net : Word) : Word;
|
||||
|
||||
begin
|
||||
ShortNetToHost:=lo(Net)*256+Hi(Net);
|
||||
end;
|
||||
|
||||
21
packages/base/netdb/hsh.inc
Normal file
21
packages/base/netdb/hsh.inc
Normal file
@ -0,0 +1,21 @@
|
||||
|
||||
Type
|
||||
THostAddr = array[1..4] of byte;
|
||||
PHostAddr = ^THostAddr;
|
||||
TNetAddr = THostAddr;
|
||||
PNetAddr = ^TNetAddr;
|
||||
|
||||
Const
|
||||
NoAddress : THostAddr = (0,0,0,0);
|
||||
NoNet : TNetAddr = (0,0,0,0);
|
||||
|
||||
function HostAddrToStr (Entry : THostAddr) : String;
|
||||
function StrToHostAddr(IP : String) : THostAddr ;
|
||||
function NetAddrToStr (Entry : TNetAddr) : String;
|
||||
function StrToNetAddr(IP : String) : TNetAddr;
|
||||
Function HostToNet (Host : ThostAddr) : THostAddr;
|
||||
Function NetToHost (Net : TNetAddr) : TNetAddr;
|
||||
Function HostToNet (Host : Longint) : Longint;
|
||||
Function NetToHost (Net : Longint) : Longint;
|
||||
Function ShortHostToNet (Host : Word) : Word;
|
||||
Function ShortNetToHost (Net : Word) : Word;
|
||||
929
packages/base/netdb/netdb.pp
Normal file
929
packages/base/netdb/netdb.pp
Normal file
@ -0,0 +1,929 @@
|
||||
{$mode objfpc}
|
||||
{$h+}
|
||||
|
||||
unit netdb;
|
||||
|
||||
Interface
|
||||
|
||||
{$i hsh.inc} // disappears if part of resolve.pp !!
|
||||
|
||||
Const
|
||||
DNSPort = 53;
|
||||
MaxServers = 4;
|
||||
MaxResolveAddr = 10;
|
||||
SResolveFile = '/etc/resolv.conf';
|
||||
SServicesFile = '/etc/services';
|
||||
SHostsFile = '/etc/hosts';
|
||||
SNetworksFile = '/etc/networks';
|
||||
|
||||
Type
|
||||
TDNSServerArray = Array[1..MaxServers] of THostAddr;
|
||||
TServiceEntry = record
|
||||
Name : String;
|
||||
Protocol : String;
|
||||
Port : Word;
|
||||
Aliases : String;
|
||||
end;
|
||||
|
||||
THostEntry = record
|
||||
Name : String;
|
||||
Addr : THostAddr;
|
||||
Aliases : String;
|
||||
end;
|
||||
|
||||
TNetworkEntry = Record
|
||||
Name : String;
|
||||
Addr : TNetAddr;
|
||||
Aliases : String;
|
||||
end;
|
||||
|
||||
Var
|
||||
DNSServers : TDNSServerArray;
|
||||
DNSServerCount : Integer;
|
||||
DefaultDomainList : String;
|
||||
CheckResolveFileAge : Boolean;
|
||||
TimeOutS,TimeOutMS : Longint;
|
||||
|
||||
|
||||
Function GetDNSServers(FN : String) : Integer;
|
||||
|
||||
Function ResolveName(HostName : String; Var Addresses : Array of THostAddr) : Integer;
|
||||
Function ResolveAddress(HostAddr : THostAddr; Var Addresses : Array of String) : Integer;
|
||||
|
||||
Function ResolveHostByName(HostName : String; Var H : THostEntry) : Boolean;
|
||||
Function ResolveHostByAddr(HostAddr : THostAddr; Var H : THostEntry) : Boolean;
|
||||
|
||||
Function GetHostByName(HostName: String; Var H : THostEntry) : boolean;
|
||||
Function GetHostByAddr(Addr: THostAddr; Var H : THostEntry) : boolean;
|
||||
|
||||
Function GetNetworkByName(NetName: String; Var N : TNetworkEntry) : boolean;
|
||||
Function GetNetworkByAddr(Addr: THostAddr; Var N : TNetworkEntry) : boolean;
|
||||
|
||||
Function GetServiceByName(Const Name,Proto : String; Var E : TServiceEntry) : Boolean;
|
||||
Function GetServiceByPort(Port : Word;Const Proto : String; Var E : TServiceEntry) : Boolean;
|
||||
|
||||
Implementation
|
||||
|
||||
uses
|
||||
linux,sockets,sysutils;
|
||||
|
||||
{$i hs.inc}
|
||||
|
||||
const
|
||||
DNSQRY_A = 1; // name to IP address
|
||||
DNSQRY_AAAA = 28; // name to IP6 address
|
||||
DNSQRY_PTR = 12; // IP address to name
|
||||
DNSQRY_MX = 15; // name to MX
|
||||
DNSQRY_TXT = 16; // name to TXT
|
||||
|
||||
// Flags 1
|
||||
QF_QR = $80;
|
||||
QF_OPCODE = $78;
|
||||
QF_AA = $04;
|
||||
QF_TC = $02; // Truncated.
|
||||
QF_RD = $01;
|
||||
|
||||
// Flags 2
|
||||
QF_RA = $80;
|
||||
QF_Z = $70;
|
||||
QF_RCODE = $0F;
|
||||
|
||||
|
||||
|
||||
Type
|
||||
TPayLoad = Array[0..511] of char;
|
||||
TQueryData = packed Record
|
||||
id : Array[0..1] of Byte;
|
||||
flags1 : Byte;
|
||||
flags2 : Byte;
|
||||
qdcount : word;
|
||||
ancount : word;
|
||||
nscount : word;
|
||||
arcount : word;
|
||||
Payload : TPayLoad;
|
||||
end;
|
||||
|
||||
TRRData = Packed record // RR record
|
||||
Atype : Word; // Answer type
|
||||
AClass : Word;
|
||||
TTL : Cardinal;
|
||||
RDLength : Word;
|
||||
end;
|
||||
|
||||
Var
|
||||
ResolveFileAge : Longint;
|
||||
ResolveFileName : String;
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
Auxiliary functions.
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
Function htons(var W : Word) : word;
|
||||
|
||||
begin
|
||||
w:=Swap(w);
|
||||
Result:=W;
|
||||
end;
|
||||
|
||||
Function ntohs(var W : Word) : Word;
|
||||
|
||||
begin
|
||||
w:=Swap(w);
|
||||
Result:=W;
|
||||
end;
|
||||
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
Resolve.conf handling
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
Function GetDNSServers(Fn : String) : Integer;
|
||||
|
||||
Var
|
||||
R : Text;
|
||||
L : String;
|
||||
I : Integer;
|
||||
H : THostAddr;
|
||||
|
||||
Function CheckDirective(Dir : String) : Boolean;
|
||||
|
||||
Var
|
||||
P : Integer;
|
||||
|
||||
begin
|
||||
P:=Pos(Dir,L);
|
||||
Result:=(P<>0);
|
||||
If Result then
|
||||
begin
|
||||
Delete(L,1,P+Length(Dir));
|
||||
Trim(L);
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
Result:=0;
|
||||
ResolveFileName:=Fn;
|
||||
ResolveFileAge:=FileAge(FN);
|
||||
{$i-}
|
||||
Assign(R,FN);
|
||||
Reset(R);
|
||||
{$i+}
|
||||
If (IOResult<>0) then
|
||||
exit;
|
||||
Try
|
||||
While not EOF(R) do
|
||||
begin
|
||||
Readln(R,L);
|
||||
I:=Pos('#',L);
|
||||
If (I<>0) then
|
||||
L:=Copy(L,1,I-1);
|
||||
If CheckDirective('nameserver') then
|
||||
begin
|
||||
H:=HostToNet(StrToHostAddr(L));
|
||||
If (H[1]<>0) then
|
||||
begin
|
||||
Inc(Result);
|
||||
DNSServers[Result]:=H;
|
||||
end;
|
||||
end
|
||||
else if CheckDirective('domain') then
|
||||
DefaultDomainList:=L
|
||||
else if CheckDirective('search') then
|
||||
DefaultDomainList:=L;
|
||||
end;
|
||||
Finally
|
||||
Close(R);
|
||||
end;
|
||||
DNSServerCount:=Result;
|
||||
end;
|
||||
|
||||
Procedure CheckResolveFile;
|
||||
|
||||
Var
|
||||
F : Integer;
|
||||
|
||||
begin
|
||||
If CheckResolveFileAge then
|
||||
begin
|
||||
F:=FileAge(ResolveFileName);
|
||||
If ResolveFileAge<F then
|
||||
GetDnsServers(ResolveFileName);
|
||||
end;
|
||||
end;
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
Payload handling functions.
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
|
||||
Procedure DumpPayLoad(Q : TQueryData; L : Integer);
|
||||
|
||||
Var
|
||||
i : Integer;
|
||||
|
||||
begin
|
||||
Writeln('Payload : ',l);
|
||||
For I:=0 to L-1 do
|
||||
Write(Byte(Q.Payload[i]),' ');
|
||||
Writeln;
|
||||
end;
|
||||
|
||||
Function BuildPayLoad(Var Q : TQueryData; Name : String; RR : Word; QClass : Word) : Integer;
|
||||
|
||||
Var
|
||||
P : PByte;
|
||||
l,S : Integer;
|
||||
|
||||
begin
|
||||
Result:=-1;
|
||||
If length(Name)>506 then
|
||||
Exit;
|
||||
Result:=0;
|
||||
P:=@Q.Payload;
|
||||
Repeat
|
||||
L:=Pos('.',Name);
|
||||
If (L=0) then
|
||||
S:=Length(Name)
|
||||
else
|
||||
S:=L-1;
|
||||
P[Result]:=S;
|
||||
Move(Name[1],P[Result+1],S);
|
||||
Inc(Result,S+1);
|
||||
If (L>0) then
|
||||
Delete(Name,1,L);
|
||||
Until (L=0);
|
||||
P[Result]:=0;
|
||||
htons(rr);
|
||||
Move(rr,P[Result+1],2);
|
||||
Inc(Result,3);
|
||||
htons(QClass);
|
||||
Move(qclass,P[Result],2);
|
||||
Inc(Result,2);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
Function NextRR(Const PayLoad : TPayLoad;Var Start : LongInt; AnsLen : LongInt; Var RR : TRRData) : Boolean;
|
||||
|
||||
Var
|
||||
I : Integer;
|
||||
HaveName : Boolean;
|
||||
PA : ^TRRData;
|
||||
RClass,RType : Word;
|
||||
|
||||
begin
|
||||
Result:=False;
|
||||
I:=Start;
|
||||
// Skip labels and pointers. At least 1 label or pointer is present.
|
||||
Repeat
|
||||
HaveName:=True;
|
||||
If (Payload[i]>#63) then // Pointer, skip
|
||||
Inc(I,2)
|
||||
else If Payload[i]=#0 then // Null termination of label, skip.
|
||||
Inc(i)
|
||||
else
|
||||
begin
|
||||
Inc(I,Ord(Payload[i])+1); // Label, continue scan.
|
||||
HaveName:=False;
|
||||
end;
|
||||
Until HaveName or (I>(AnsLen-SizeOf(TRRData)));
|
||||
Result:=(I<=(AnsLen-SizeOf(TRRData)));
|
||||
// Check RR record.
|
||||
PA:=@Payload[i];
|
||||
RR:=PA^;
|
||||
Start:=I+SizeOf(TRRData);
|
||||
end;
|
||||
|
||||
|
||||
Function BuildName (Const PayLoad : TPayLoad; Start,len : Integer) : String;
|
||||
|
||||
Const
|
||||
FIREDNS_POINTER_VALUE = $C000;
|
||||
|
||||
Var
|
||||
I,O : Integer;
|
||||
P : Word;
|
||||
|
||||
begin
|
||||
SetLength(Result,512);
|
||||
I:=Start;
|
||||
O:=1;
|
||||
// Copy labels and pointers. At least 1 label or pointer is present.
|
||||
Repeat
|
||||
If (Payload[i]>#63) then // Pointer, move.
|
||||
begin
|
||||
Move(Payload[i],P,2);
|
||||
I:=ntohs(p)-FIREDNS_POINTER_VALUE-12;
|
||||
end
|
||||
else if Payload[i]<>#0 then // Label, copy
|
||||
begin
|
||||
If O<>1 then
|
||||
begin
|
||||
Result[O]:='.';
|
||||
Inc(O);
|
||||
end;
|
||||
P:=Ord(Payload[i]);
|
||||
Move(Payload[i+1],Result[o],P);
|
||||
Inc(I,P+1);
|
||||
Inc(O,P);
|
||||
end;
|
||||
Until (Payload[I]=#0);
|
||||
end;
|
||||
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
QueryData handling functions
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
Function CheckAnswer(Const Qry : TQueryData; Var Ans : TQueryData) : Boolean;
|
||||
|
||||
begin
|
||||
Result:=False;
|
||||
With Ans do
|
||||
begin
|
||||
// Check ID.
|
||||
If (ID[1]<>QRY.ID[1]) or (ID[0]<>Qry.ID[0]) then
|
||||
exit;
|
||||
// Flags ?
|
||||
If (Flags1 and QF_QR)=0 then
|
||||
exit;
|
||||
if (Flags1 and QF_OPCODE)<>0 then
|
||||
exit;
|
||||
if (Flags2 and QF_RCODE)<>0 then
|
||||
exit;
|
||||
// Number of answers ?
|
||||
htons(Ancount);
|
||||
If Ancount<1 then
|
||||
Exit;
|
||||
Result:=True;
|
||||
end;
|
||||
end;
|
||||
|
||||
Function SkipAnsQueries(Var Ans : TQueryData; L : Integer) : integer;
|
||||
|
||||
Var
|
||||
Q,I : Integer;
|
||||
|
||||
begin
|
||||
Result:=0;
|
||||
With Ans do
|
||||
begin
|
||||
htons(qdcount);
|
||||
i:=0;
|
||||
q:=0;
|
||||
While (Q<qdcount) and (i<l) do
|
||||
begin
|
||||
If Ord(Payload[i])>63 then
|
||||
begin
|
||||
Inc(I,6);
|
||||
Inc(Q);
|
||||
end
|
||||
else
|
||||
begin
|
||||
If Payload[i]=#0 then
|
||||
begin
|
||||
inc(q);
|
||||
Inc(I,5);
|
||||
end
|
||||
else
|
||||
Inc(I,Ord(Payload[i])+1);
|
||||
end;
|
||||
end;
|
||||
Result:=I;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
DNS Query functions.
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
|
||||
Function Query(Resolver : Integer; Var Qry,Ans : TQueryData; QryLen : Integer; Var AnsLen : Integer) : Boolean;
|
||||
|
||||
Var
|
||||
BA,SA : TInetSockAddr;
|
||||
Sock,L,I : Longint;
|
||||
Al,RTO : Longint;
|
||||
ReadFDS : FDSet;
|
||||
|
||||
begin
|
||||
Result:=False;
|
||||
With Qry do
|
||||
begin
|
||||
ID[0]:=Random(256);
|
||||
ID[1]:=Random(256);
|
||||
Flags1:=QF_RD;
|
||||
Flags2:=0;
|
||||
qdcount:=1 shl 8;
|
||||
ancount:=0;
|
||||
nscount:=0;
|
||||
arcount:=0;
|
||||
end;
|
||||
Sock:=Socket(PF_INET,SOCK_DGRAM,0);
|
||||
If Sock=-1 then
|
||||
exit;
|
||||
With SA do
|
||||
begin
|
||||
family:=AF_INET;
|
||||
port:=DNSport;
|
||||
htons(port);
|
||||
addr:=cardinal(HostToNet(DNSServers[Resolver]));
|
||||
end;
|
||||
sendto(sock,qry,qrylen+12,0,SA,SizeOf(SA));
|
||||
// Wait for answer.
|
||||
RTO:=TimeOutS*1000+TimeOutMS;
|
||||
FD_ZERO(ReadFDS);
|
||||
FD_Set(Sock,readfds);
|
||||
if Select(Sock+1,@readfds,Nil,Nil,RTO)<=0 then
|
||||
begin
|
||||
fdclose(Sock);
|
||||
exit;
|
||||
end;
|
||||
AL:=SizeOf(SA);
|
||||
L:=recvfrom(Sock,ans,SizeOf(Ans),0,SA,AL);
|
||||
fdclose(Sock);
|
||||
// Check lenght answer and fields in header data.
|
||||
If (L<12) or not CheckAnswer(Qry,Ans) Then
|
||||
exit;
|
||||
// Return Payload length.
|
||||
Anslen:=L-12;
|
||||
Result:=True;
|
||||
end;
|
||||
|
||||
Function ResolveNameAt(Resolver : Integer; HostName : String; Var Addresses : Array of THostAddr) : Integer;
|
||||
|
||||
Var
|
||||
Qry, Ans : TQueryData;
|
||||
MaxAnswer,I,QryLen,
|
||||
AnsLen,AnsStart : Longint;
|
||||
RR : TRRData;
|
||||
|
||||
begin
|
||||
Result:=0;
|
||||
QryLen:=BuildPayLoad(Qry,HostName,DNSQRY_A,1);
|
||||
If Not Query(Resolver,Qry,Ans,QryLen,AnsLen) then
|
||||
Result:=-1
|
||||
else
|
||||
begin
|
||||
AnsStart:=SkipAnsQueries(Ans,AnsLen);
|
||||
MaxAnswer:=Ans.AnCount-1;
|
||||
If MaxAnswer>High(Addresses) then
|
||||
MaxAnswer:=High(Addresses);
|
||||
I:=0;
|
||||
While (I<=MaxAnswer) and NextRR(Ans.Payload,AnsStart,AnsLen,RR) do
|
||||
begin
|
||||
if (Ntohs(RR.AType)=DNSQRY_A) and (1=NtoHS(RR.AClass)) then
|
||||
begin
|
||||
Move(Ans.PayLoad[AnsStart],Addresses[i],SizeOf(THostAddr));
|
||||
inc(Result);
|
||||
Inc(AnsStart,RR.RDLength);
|
||||
end;
|
||||
Inc(I);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
Function ResolveName(HostName : String; Var Addresses : Array of THostAddr) : Integer;
|
||||
|
||||
Var
|
||||
I : Integer;
|
||||
|
||||
begin
|
||||
CheckResolveFile;
|
||||
I:=1;
|
||||
Result:=0;
|
||||
While (Result=0) and (I<=DNSServerCount) do
|
||||
begin
|
||||
Result:=ResolveNameAt(I,HostName,Addresses);
|
||||
Inc(I);
|
||||
end;
|
||||
end;
|
||||
|
||||
Function ResolveAddressAt(Resolver : Integer; Address : String; Var Names : Array of String) : Integer;
|
||||
|
||||
|
||||
Var
|
||||
Qry, Ans : TQueryData;
|
||||
MaxAnswer,I,QryLen,
|
||||
AnsLen,AnsStart : Longint;
|
||||
RR : TRRData;
|
||||
S : String;
|
||||
begin
|
||||
Result:=0;
|
||||
QryLen:=BuildPayLoad(Qry,Address,DNSQRY_PTR,1);
|
||||
If Not Query(Resolver,Qry,Ans,QryLen,AnsLen) then
|
||||
Result:=-1
|
||||
else
|
||||
begin
|
||||
AnsStart:=SkipAnsQueries(Ans,AnsLen);
|
||||
MaxAnswer:=Ans.AnCount-1;
|
||||
If MaxAnswer>High(Names) then
|
||||
MaxAnswer:=High(Names);
|
||||
I:=0;
|
||||
While (I<=MaxAnswer) and NextRR(Ans.Payload,AnsStart,AnsLen,RR) do
|
||||
begin
|
||||
if (Ntohs(RR.AType)=DNSQRY_PTR) and (1=NtoHS(RR.AClass)) then
|
||||
begin
|
||||
Names[i]:=BuildName(Ans.Payload,AnsStart,AnsLen);
|
||||
inc(Result);
|
||||
Inc(AnsStart,RR.RDLength);
|
||||
end;
|
||||
Inc(I);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
Function ResolveAddress(HostAddr : THostAddr; Var Addresses : Array of String) : Integer;
|
||||
|
||||
Var
|
||||
I : Integer;
|
||||
S : String;
|
||||
|
||||
begin
|
||||
CheckResolveFile;
|
||||
I:=1;
|
||||
Result:=0;
|
||||
S:=Format('%d.%d.%d.%d.in-addr.arpa',[HostAddr[4],HostAddr[3],HostAddr[2],HostAddr[1]]);
|
||||
While (Result=0) and (I<=DNSServerCount) do
|
||||
begin
|
||||
Result:=ResolveAddressAt(I,S,Addresses);
|
||||
Inc(I);
|
||||
end;
|
||||
end;
|
||||
|
||||
Function ResolveHostByName(HostName : String; Var H : THostEntry) : Boolean;
|
||||
|
||||
Var
|
||||
Address : Array[1..MaxResolveAddr] of THostAddr;
|
||||
L : Integer;
|
||||
|
||||
begin
|
||||
L:=ResolveName(HostName,Address);
|
||||
Result:=(L>0);
|
||||
If Result then
|
||||
begin
|
||||
// We could add a reverse call here to get the real name and aliases.
|
||||
H.Name:=HostName;
|
||||
H.Addr:=Address[1];
|
||||
H.aliases:='';
|
||||
end;
|
||||
end;
|
||||
|
||||
Function ResolveHostByAddr(HostAddr : THostAddr; Var H : THostEntry) : Boolean;
|
||||
|
||||
Var
|
||||
Names : Array[1..MaxResolveAddr] of String;
|
||||
I,L : Integer;
|
||||
|
||||
begin
|
||||
L:=ResolveAddress(HostAddr,Names);
|
||||
Result:=(L>0);
|
||||
If Result then
|
||||
begin
|
||||
H.Name:=Names[1];
|
||||
H.Addr:=HostAddr;
|
||||
H.Aliases:='';
|
||||
If (L>1) then
|
||||
For I:=2 to L do
|
||||
If (I=2) then
|
||||
H.Aliases:=Names[i]
|
||||
else
|
||||
H.Aliases:=H.Aliases+','+Names[i];
|
||||
end;
|
||||
end;
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
Some Parsing routines
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
Const
|
||||
Whitespace = [' ',#9];
|
||||
|
||||
Function NextWord(Var Line : String) : String;
|
||||
|
||||
Var
|
||||
I,J : Integer;
|
||||
|
||||
begin
|
||||
I:=1;
|
||||
While (I<=Length(Line)) and (Line[i] in Whitespace) do
|
||||
inc(I);
|
||||
J:=I;
|
||||
While (J<=Length(Line)) and Not (Line[J] in WhiteSpace) do
|
||||
inc(j);
|
||||
Result:=Copy(Line,I,J-1);
|
||||
Delete(Line,1,J);
|
||||
end;
|
||||
|
||||
Procedure StripComment(Var line : String);
|
||||
|
||||
Var
|
||||
P : Integer;
|
||||
|
||||
begin
|
||||
P:=Pos('#',Line);
|
||||
If (P<>0) then
|
||||
Line:=Trim(Copy(Line,1,P-1));
|
||||
end;
|
||||
|
||||
Function MatchNameOrAlias(Const Entry,Name: String; Aliases : String) : Boolean;
|
||||
|
||||
Var
|
||||
P : Integer;
|
||||
A : String;
|
||||
|
||||
begin
|
||||
Result:=CompareText(Entry,Name)=0;
|
||||
If Not Result then
|
||||
While (Not Result) and (Length(Aliases)>0) do
|
||||
begin
|
||||
P:=Pos(',',Aliases);
|
||||
If (P=0) then
|
||||
P:=Length(Aliases)+1;
|
||||
A:=Copy(Aliases,1,P-1);
|
||||
Delete(Aliases,1,P);
|
||||
Result:=CompareText(A,Entry)=0;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
/etc/hosts handling.
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
Function GetNextHostEntry(var F : Text; Var H : THostEntry): boolean;
|
||||
|
||||
Var
|
||||
Line,S : String;
|
||||
P : Integer;
|
||||
|
||||
begin
|
||||
Result:=False;
|
||||
Repeat
|
||||
ReadLn(F,Line);
|
||||
StripComment(Line);
|
||||
S:=NextWord(Line);
|
||||
If (S<>'') then
|
||||
begin
|
||||
H.Addr:=StrToHostAddr(S);
|
||||
if (H.Addr[1]<>0) then
|
||||
begin
|
||||
S:=NextWord(Line);
|
||||
If (S<>'') then
|
||||
begin
|
||||
H.Name:=S;
|
||||
Result:=True;
|
||||
H.Aliases:='';
|
||||
Repeat
|
||||
S:=NextWord(line);
|
||||
If (S<>'') then
|
||||
If (H.Aliases='') then
|
||||
H.Aliases:=S
|
||||
else
|
||||
H.Aliases:=H.Aliases+','+S;
|
||||
until (S='');
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
until Result or EOF(F);
|
||||
end;
|
||||
|
||||
Function FindHostEntryInHostsFile(N: String; Addr: THostAddr; Var H : THostEntry) : boolean;
|
||||
|
||||
Var
|
||||
F : Text;
|
||||
HE : THostEntry;
|
||||
|
||||
begin
|
||||
Result:=False;
|
||||
If FileExists(SHostsFile) then
|
||||
begin
|
||||
Assign(F,SHostsFile);
|
||||
{$i-}
|
||||
Reset(F);
|
||||
{$i+}
|
||||
If (IOResult=0) then
|
||||
begin
|
||||
While Not Result and GetNextHostEntry(F,HE) do
|
||||
begin
|
||||
If (N<>'') then
|
||||
Result:=MatchNameOrAlias(N,HE.Name,HE.Aliases)
|
||||
else
|
||||
Result:=Cardinal(Addr)=Cardinal(HE.Addr);
|
||||
end;
|
||||
Close(f);
|
||||
If Result then
|
||||
begin
|
||||
H.Name:=HE.Name;
|
||||
H.Addr:=HE.Addr;
|
||||
H.Aliases:=HE.Aliases;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
Function GetHostByName(HostName: String; Var H : THostEntry) : boolean;
|
||||
|
||||
begin
|
||||
Result:=FindHostEntryInHostsFile(HostName,NoAddress,H);
|
||||
end;
|
||||
|
||||
|
||||
Function GetHostByAddr(Addr: THostAddr; Var H : THostEntry) : boolean;
|
||||
|
||||
begin
|
||||
Result:=FindHostEntryInHostsFile('',Addr,H);
|
||||
end;
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
/etc/networks handling
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
Function GetNextNetworkEntry(var F : Text; Var N : TNetworkEntry): boolean;
|
||||
|
||||
Var
|
||||
NN,Line,S : String;
|
||||
P : Integer;
|
||||
A : TNetAddr;
|
||||
|
||||
begin
|
||||
Result:=False;
|
||||
Repeat
|
||||
ReadLn(F,Line);
|
||||
StripComment(Line);
|
||||
S:=NextWord(Line);
|
||||
If (S<>'') then
|
||||
begin
|
||||
NN:=S;
|
||||
A:=StrToHostAddr(NextWord(Line));
|
||||
Result:=(NN<>'') and (A[1]<>0); // Valid addr.
|
||||
If result then
|
||||
begin
|
||||
N.Addr:=A;
|
||||
N.Name:=NN;
|
||||
N.Aliases:='';
|
||||
end;
|
||||
end;
|
||||
until Result or EOF(F);
|
||||
end;
|
||||
|
||||
Function FindNetworkEntryInNetworksFile(Net: String; Addr: TNetAddr; Var N : TNetworkEntry) : boolean;
|
||||
|
||||
Var
|
||||
F : Text;
|
||||
NE : TNetworkEntry;
|
||||
|
||||
begin
|
||||
Result:=False;
|
||||
If FileExists(SNetworksFile) then
|
||||
begin
|
||||
Assign(F,SNetworksFile);
|
||||
{$i-}
|
||||
Reset(F);
|
||||
{$i+}
|
||||
If (IOResult=0) then
|
||||
begin
|
||||
While Not Result and GetNextNetworkEntry(F,NE) do
|
||||
begin
|
||||
If (Net<>'') then
|
||||
Result:=MatchNameOrAlias(Net,NE.Name,NE.Aliases)
|
||||
else
|
||||
Result:=Cardinal(Addr)=Cardinal(NE.Addr);
|
||||
end;
|
||||
Close(f);
|
||||
If Result then
|
||||
begin
|
||||
N.Name:=NE.Name;
|
||||
N.Addr:=NE.Addr;
|
||||
N.Aliases:=NE.Aliases;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
Function GetNetworkByName(NetName: String; Var N : TNetworkEntry) : boolean;
|
||||
|
||||
begin
|
||||
Result:=FindNetworkEntryInNetworksFile(NetName,NoNet,N);
|
||||
end;
|
||||
|
||||
Function GetNetworkByAddr(Addr: THostAddr; Var N : TNetworkEntry) : boolean;
|
||||
|
||||
begin
|
||||
Result:=FindNetworkEntryInNetworksFile('',Addr,N);
|
||||
end;
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
/etc/services section
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
Function GetNextServiceEntry(Var F : Text; Var E : TServiceEntry) : Boolean;
|
||||
|
||||
|
||||
Var
|
||||
Line,S : String;
|
||||
P : INteger;
|
||||
|
||||
begin
|
||||
Result:=False;
|
||||
Repeat
|
||||
ReadLn(F,Line);
|
||||
StripComment(Line);
|
||||
S:=NextWord(Line);
|
||||
If (S<>'') then
|
||||
begin
|
||||
E.Name:=S;
|
||||
S:=NextWord(Line);
|
||||
P:=Pos('/',S);
|
||||
If (P<>0) then
|
||||
begin
|
||||
E.Port:=StrToIntDef(Copy(S,1,P-1),0);
|
||||
If (E.Port<>0) then
|
||||
begin
|
||||
E.Protocol:=Copy(S,P+1,Length(S)-P);
|
||||
Result:=length(E.Protocol)>0;
|
||||
E.Aliases:='';
|
||||
Repeat
|
||||
S:=NextWord(Line);
|
||||
If (S<>'') then
|
||||
If (Length(E.Aliases)=0) then
|
||||
E.aliases:=S
|
||||
else
|
||||
E.Aliases:=E.Aliases+','+S;
|
||||
until (S='');
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
until Result or EOF(F);
|
||||
end;
|
||||
|
||||
|
||||
Function FindServiceEntryInFile(Const Name,Proto : String; Port : Integer; Var E : TServiceEntry) : Boolean;
|
||||
|
||||
Var
|
||||
F : Text;
|
||||
TE : TServiceEntry;
|
||||
|
||||
begin
|
||||
Result:=False;
|
||||
If FileExists(SServicesFile) then
|
||||
begin
|
||||
Assign(F,SServicesFile);
|
||||
{$i-}
|
||||
Reset(F);
|
||||
{$i+}
|
||||
If (IOResult=0) then
|
||||
begin
|
||||
While Not Result and GetNextServiceEntry(F,TE) do
|
||||
begin
|
||||
If (Port=-1) then
|
||||
Result:=MatchNameOrAlias(Name,TE.Name,TE.Aliases)
|
||||
else
|
||||
Result:=(Port=TE.Port);
|
||||
If Result and (Proto<>'') then
|
||||
Result:=(Proto=TE.Protocol);
|
||||
end;
|
||||
Close(f);
|
||||
If Result then
|
||||
begin
|
||||
E.Name:=TE.Name;
|
||||
E.Port:=TE.Port;
|
||||
E.Protocol:=TE.Protocol;
|
||||
E.Aliases:=TE.Aliases;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
Function GetServiceByName(Const Name,Proto : String; Var E : TServiceEntry) : Boolean;
|
||||
|
||||
begin
|
||||
Result:=FindServiceEntryInFile(Name,Proto,-1,E);
|
||||
end;
|
||||
|
||||
Function GetServiceByPort(Port : Word;Const Proto : String; Var E : TServiceEntry) : Boolean;
|
||||
|
||||
begin
|
||||
Result:=FindServiceEntryInFile('',Proto,Port,E);
|
||||
end;
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
Initialization section
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
Procedure InitResolver;
|
||||
|
||||
Var
|
||||
I : Integer;
|
||||
|
||||
begin
|
||||
TimeOutS :=5;
|
||||
TimeOutMS:=0;
|
||||
CheckResolveFileAge:=False;
|
||||
If FileExists(SResolveFile) then
|
||||
GetDNsservers(SResolveFile);
|
||||
end;
|
||||
|
||||
begin
|
||||
InitResolver;
|
||||
end.
|
||||
68
packages/base/netdb/testdns.pp
Normal file
68
packages/base/netdb/testdns.pp
Normal file
@ -0,0 +1,68 @@
|
||||
{$mode objfpc}
|
||||
{$h+}
|
||||
|
||||
program testdns;
|
||||
|
||||
uses netdb;
|
||||
|
||||
Procedure DumpHostEntry(Const H : THostEntry);
|
||||
|
||||
begin
|
||||
With H do
|
||||
begin
|
||||
Writeln('Name : ',Name);
|
||||
Writeln('Addr : ',HostAddrToStr(Addr));
|
||||
Writeln('Aliases : ',Aliases);
|
||||
Writeln;
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure TestAddr(Addr : string);
|
||||
|
||||
Var
|
||||
H : THostEntry;
|
||||
|
||||
begin
|
||||
If ResolveHostByAddr(StrToHostAddr(Addr),H) then
|
||||
DumpHostEntry(H)
|
||||
else
|
||||
Writeln('No entry for address ',Addr)
|
||||
end;
|
||||
|
||||
Procedure TestName(Const N : string);
|
||||
|
||||
Var
|
||||
H : THostEntry;
|
||||
|
||||
begin
|
||||
If ResolveHostByName(N,H) then
|
||||
DumpHostEntry(H)
|
||||
else
|
||||
Writeln('No entry for hostname ',N)
|
||||
end;
|
||||
|
||||
Var
|
||||
I,l : INteger;
|
||||
Ans : Array [1..10] of THostAddr;
|
||||
H : THostAddr;
|
||||
NAns : Array[1..10] of String;
|
||||
|
||||
|
||||
|
||||
begin
|
||||
Writeln('Resolving name ');
|
||||
l:=ResolveName('malpertuus.wisa.be',Ans);
|
||||
Writeln('Got : ',l,' answers');
|
||||
For I:=1 to l do
|
||||
Writeln(i:2,': ',hostAddrtostr(Ans[i]));
|
||||
Writeln('Resolving address ');
|
||||
H:=StrtoHostAddr('212.224.143.202');
|
||||
L:=ResolveAddress(H,NAns);
|
||||
Writeln('Got : ',l,' answers');
|
||||
For I:=1 to l do
|
||||
Writeln(i:2,': ',NAns[i]);
|
||||
Writeln('ResolveHostByName:');
|
||||
testname('malpertuus.wisa.be');
|
||||
Writeln('ResolveHostByAddr:');
|
||||
testaddr('212.224.143.202');
|
||||
end.
|
||||
47
packages/base/netdb/testhst.pp
Normal file
47
packages/base/netdb/testhst.pp
Normal file
@ -0,0 +1,47 @@
|
||||
program testhst;
|
||||
|
||||
uses netdb;
|
||||
|
||||
Procedure DumpHostEntry(Const H : THostEntry);
|
||||
|
||||
begin
|
||||
With H do
|
||||
begin
|
||||
Writeln('Name : ',Name);
|
||||
Writeln('Addr : ',HostAddrToStr(Addr));
|
||||
Writeln('Aliases : ',Aliases);
|
||||
Writeln;
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure TestAddr(Addr : string);
|
||||
|
||||
Var
|
||||
H : THostEntry;
|
||||
|
||||
begin
|
||||
If GetHostByAddr(StrToHostAddr(Addr),H) then
|
||||
DumpHostEntry(H)
|
||||
else
|
||||
Writeln('No entry for address ',Addr)
|
||||
end;
|
||||
|
||||
Procedure TestName(Const N : string);
|
||||
|
||||
Var
|
||||
H : THostEntry;
|
||||
|
||||
begin
|
||||
If GetHostByName(N,H) then
|
||||
DumpHostEntry(H)
|
||||
else
|
||||
Writeln('No entry for hostname ',N)
|
||||
end;
|
||||
|
||||
begin
|
||||
testaddr('127.0.0.1');
|
||||
testaddr('212.224.143.213');
|
||||
testname('LOCALHOST');
|
||||
testname('www.freepascal.org');
|
||||
testname('obelix.wisa.be');
|
||||
end.
|
||||
44
packages/base/netdb/testnet.pp
Normal file
44
packages/base/netdb/testnet.pp
Normal file
@ -0,0 +1,44 @@
|
||||
program testhst;
|
||||
|
||||
uses netdb;
|
||||
|
||||
Procedure DumpNetEntry(Const N : TNetworkEntry);
|
||||
|
||||
begin
|
||||
With N do
|
||||
begin
|
||||
Writeln('Name : ',Name);
|
||||
Writeln('Addr : ',HostAddrToStr(Addr));
|
||||
Writeln('Aliases : ',Aliases);
|
||||
Writeln;
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure TestAddr(Addr : string);
|
||||
|
||||
Var
|
||||
N : TNetworkEntry;
|
||||
|
||||
begin
|
||||
If GetNetworkByAddr(StrToHostAddr(Addr),N) then
|
||||
DumpNetEntry(N)
|
||||
else
|
||||
Writeln('No entry for address ',Addr)
|
||||
end;
|
||||
|
||||
Procedure TestName(Const Net : string);
|
||||
|
||||
Var
|
||||
N : TNetworkEntry;
|
||||
|
||||
begin
|
||||
If GetNetworkByName(Net,N) then
|
||||
DumpNetEntry(N)
|
||||
else
|
||||
Writeln('No entry for netname ',Net)
|
||||
end;
|
||||
|
||||
begin
|
||||
testaddr('127.0.0.0');
|
||||
testname('loopback');
|
||||
end.
|
||||
49
packages/base/netdb/testsvc.pp
Normal file
49
packages/base/netdb/testsvc.pp
Normal file
@ -0,0 +1,49 @@
|
||||
program testsvc;
|
||||
|
||||
uses netdb;
|
||||
|
||||
Procedure DumpServiceEntry(Const E : TserviceEntry);
|
||||
|
||||
begin
|
||||
With E do
|
||||
begin
|
||||
Writeln('Name : ',Name);
|
||||
Writeln('Protocol : ',Protocol);
|
||||
Writeln('Port : ',Port);
|
||||
Writeln('Aliases : ',Aliases);
|
||||
Writeln;
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure TestPort(P : Word; Const Proto : string);
|
||||
|
||||
Var
|
||||
E : TServiceEntry;
|
||||
|
||||
begin
|
||||
If GetServiceByPort(P,Proto,E) then
|
||||
DumpServiceEntry(E)
|
||||
else
|
||||
Writeln('No entry for port ',P)
|
||||
end;
|
||||
|
||||
Procedure TestName(Const N,Proto : string);
|
||||
|
||||
Var
|
||||
E : TServiceEntry;
|
||||
|
||||
begin
|
||||
If GetServiceByName(N,Proto,E) then
|
||||
DumpServiceEntry(E)
|
||||
else
|
||||
Writeln('No entry for service ',N)
|
||||
end;
|
||||
|
||||
begin
|
||||
testport(25,'');
|
||||
testport(23,'');
|
||||
testport(53,'udp');
|
||||
testname('mail','');
|
||||
testname('ftp','');
|
||||
testname('domain','udp');
|
||||
end.
|
||||
Loading…
Reference in New Issue
Block a user