paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-07-09 16:36:03 +02:00
Code Issues Packages Projects Releases Wiki Activity
c400fbe5b2
fpc/packages/base/netdb/netdb.pp

1095 lines
24 KiB
ObjectPascal
Raw Blame History

{
$Id$
This file is part of the Free Pascal run time library.
Copyright (c) 2003 by the Free Pascal development team
Implement networking routines.
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
{$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';
MaxRecursion = 10;
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 ResolveName6(HostName : String; Var Addresses : Array of THostAddr6) : 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
{$ifdef VER1_0}
Linux,
{$else}
BaseUnix,
{$endif}
sockets,sysutils;
{$i hs.inc}
const
{ from http://www.iana.org/assignments/dns-parameters }
DNSQRY_A = 1; // name to IP address
DNSQRY_AAAA = 28; // name to IP6 address
DNSQRY_A6 = 38; // name to IP6 (new)
DNSQRY_PTR = 12; // IP address to name
DNSQRY_MX = 15; // name to MX
DNSQRY_TXT = 16; // name to TXT
DNSQRY_CNAME = 5;
// 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 htonl(i:integer):integer;
begin
{$ifdef ENDIAN_LITTLE}
result := (i shr 24) or (i shr 8 and $ff00) or (i shl 8 and $ff0000) or (i shl 24 and $ff000000);
{$else}
result := i;
{$endif}
end;
Function htons(var W : Word) : word;
begin
{$ifdef ENDIAN_LITTLE}
result := ((w and $ff00) shr 8) or ((w and $ff) shl 8);
{$else}
result := w;
{$endif}
w := result;
end;
Function ntohs(var W : Word) : Word;
begin
{$ifdef ENDIAN_LITTLE}
result := ((w and $ff00) shr 8) or ((w and $ff) shl 8);
{$else}
result := w;
{$endif}
w := result;
end;
function ntohl(i:integer):integer;
begin
{$ifdef ENDIAN_LITTLE}
result := (i shr 24) or (i shr 8 and $ff00) or (i shl 8 and $ff0000) or (i shl 24 and $ff000000);
{$else}
result := i;
{$endif}
i := result;
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 : {$ifdef VER1_0}FDSet{$ELSE}TFDSet{$ENDIF};
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;
{$ifdef VER1_0}FD_ZERO{$else}fpFD_ZERO{$endif}(ReadFDS);
{$ifdef VER1_0}
FD_Set(Sock,readfds);
{$else}
fpFD_Set(sock,readfds);
{$endif}
if {$ifdef ver1_0}Select{$else}fpSelect{$endif}(Sock+1,@readfds,Nil,Nil,RTO)<=0 then
begin
{$ifdef VER1_0}fdclose{$ELSE}fpclose{$endif}(Sock);
exit;
end;
AL:=SizeOf(SA);
L:=recvfrom(Sock,ans,SizeOf(Ans),0,SA,AL);
{$ifdef VER1_0}fdclose{$ELSE}fpclose{$endif}(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 stringfromlabel(pl: TPayLoad; start: integer): string;
var
l,i: integer;
begin
result := '';
l := 0;
i := 0;
repeat
l := ord(pl[start]);
if l <> 0 then begin
setlength(result,length(result)+l);
move(pl[start+1],result[i+1],l);
result := result + '.';
inc(start,l); inc(start);
inc(i,l); inc(i);
end;
until l = 0;
if result[length(result)] = '.' then setlength(result,length(result)-1);
end;
Function ResolveNameAt6(Resolver : Integer; HostName : String; Var Addresses : Array of THostAddr6; Recurse: Integer) : Integer;
Var
Qry, Ans : TQueryData;
MaxAnswer,I,QryLen,
AnsLen,AnsStart : Longint;
RR : TRRData;
cname : string;
begin
Result:=0;
QryLen:=BuildPayLoad(Qry,HostName,DNSQRY_AAAA,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 (1=NtoHS(RR.AClass)) then
case ntohs(rr.atype) of
DNSQRY_AAAA: begin
Move(Ans.PayLoad[AnsStart],Addresses[i],SizeOf(THostAddr6));
inc(Result);
rr.rdlength := ntohs(rr.rdlength);
Inc(AnsStart,RR.RDLength);
end;
DNSQRY_CNAME: begin
if Recurse >= MaxRecursion then begin
Result := -1;
exit;
end;
rr.rdlength := ntohs(rr.rdlength);
writeln(rr.rdlength);
setlength(cname, rr.rdlength);
cname := stringfromlabel(ans.payload, ansstart);
writeln(cname);
Result := ResolveNameAt6(Resolver, cname, Addresses, Recurse+1);
exit; // FIXME: what about other servers?!
end;
end;
Inc(I);
end;
end;
end;
Function ResolveName6(HostName: String; Var Addresses: Array of THostAddr6) : Integer;
var
i: Integer;
begin
CheckResolveFile;
i := 1;
Result := 0;
while (Result = 0) and (I<= DNSServerCount) do begin
Result := ResolveNameAt6(I, Hostname, Addresses, 0);
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.
{
$Log$
Revision 1.8 2003-11-22 23:17:50 michael
Patch for ipv6 and CNAME record support from Johannes Berg
Revision 1.7 2003/09/29 19:21:19 marco
* ; added to line 150
Revision 1.6 2003/09/29 07:44:11 michael
+ Endian patch from bas steendijk@xs4all.nl
Revision 1.5 2003/09/28 09:34:02 peter
* unix fix for 1.0.x
Revision 1.4 2003/09/18 16:30:23 marco
* unixreform fix
Revision 1.3 2003/05/17 20:54:03 michael
+ uriparser unit added. Header/Footer blocks added
}
Reference in New Issue View Git Blame Copy Permalink