paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-09 12:46:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

* /etc/ location hardcoded only for Unix targets, support for retrieval from the environment added for platforms using it

Browse Source 
git-svn-id: trunk@19455 -
This commit is contained in:
Tomas Hajny 2011-10-10 22:50:34 +00:00
parent 0bc02701bd
commit f10fbba180
1 changed files with 68 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

86
packages/fcl-net/src/netdb.pp
View File

@ -29,6 +29,26 @@ Interface
Uses Sockets;
{$IFDEF OS2}
(* ETC directory location determined by environment variable ETC *)
{$DEFINE ETC_BY_ENV}
(* Use names supported also on non-LFN drives like plain FAT-16. *)
{$DEFINE SFN_VERSION}
{$ENDIF OS2}
{$IFDEF GO32V2}
{$DEFINE ETC_BY_ENV}
{$DEFINE SFN_VERSION}
{$ENDIF GO32V2}
{$IFDEF WATCOM}
{$DEFINE ETC_BY_ENV}
{$DEFINE SFN_VERSION}
{$ENDIF WATCOM}
{$IFDEF UNIX}
(* ETC directory location hardcoded to /etc/ *)
{$DEFINE UNIX_ETC}
{$ENDIF UNIX}
Type
THostAddr = in_addr; // historical aliases for these.
THostAddr6= Tin6_addr;
@ -37,15 +57,28 @@ Type
Const
DNSPort = 53;
MaxResolveAddr = 10;
SResolveFile = '/etc/resolv.conf';
SServicesFile = '/etc/services';
SHostsFile = '/etc/hosts';
SNetworksFile = '/etc/networks';
SProtocolFile = '/etc/protocols';
SServicesFile = 'services';
SHostsFile = 'hosts';
SNetworksFile = 'networks';
{$IFDEF SFN_VERSION}
SProtocolFile = 'protocol';
SResolveFile = 'resolv';
{$IFDEF OS2}
(* Peculiarity of OS/2 - depending on the used TCP/IP version, *)
(* the file differs slightly in name and partly also content. *)
SResolveFile2 = 'resolv2';
{$ENDIF OS2}
{$ELSE SFN_VERSION}
SProtocolFile = 'protocols';
SResolveFile = 'resolv.conf';
{$ENDIF SFN_VERSION}
MaxRecursion = 10;
MaxIP4Mapped = 10;
var
EtcPath: string;
Type
TDNSServerArray = Array of THostAddr;
TServiceEntry = record
@ -387,12 +420,12 @@ Var
begin
If CheckHostsFileAge then
begin
F:=FileAge(SHostsFile);
F:=FileAge (EtcPath + SHostsFile);
If HostsFileAge<F then
begin
// Rescan.
FreeHostsList(HostsList);
HostsList:=ProcessHosts(SHostsFile);
HostsList:=ProcessHosts (EtcPath + SHostsFile);
HostsFileAge:=F;
end;
end;
@ -1164,9 +1197,9 @@ Var
begin
Result:=False;
If FileExists(SProtocolFile) then
If FileExists (EtcPath + SProtocolFile) then
begin
Assign(F,SProtocolFile);
Assign (F, EtcPath + SProtocolFile);
{$push}{$i-}
Reset(F);
{$pop}
@ -1266,9 +1299,9 @@ Var
begin
Result:=False;
If FileExists(SNetworksFile) then
If FileExists (EtcPath + SNetworksFile) then
begin
Assign(F,SNetworksFile);
Assign (F, EtcPath + SNetworksFile);
{$push}{$i-}
Reset(F);
{$pop}
@ -1359,9 +1392,9 @@ Var
begin
Result:=False;
If FileExists(SServicesFile) then
If FileExists (EtcPath + SServicesFile) then
begin
Assign(F,SServicesFile);
Assign (F, EtcPath + SServicesFile);
{$push}{$i-}
Reset(F);
{$pop}
@ -1413,11 +1446,28 @@ begin
TimeOutS :=5;
TimeOutMS:=0;
CheckHostsFileAge:=False;
If FileExists(SHostsFile) then
HostsList:=ProcessHosts(SHostsFile);
{$IFDEF UNIX_ETC}
EtcPath := '/etc/';
{$ELSE UNIX_ETC}
{$IFDEF ETC_BY_ENV}
EtcPath := GetEnvironmentVariable ('ETC');
if (EtcPath <> '') and (EtcPath [Length (EtcPath)] <> DirectorySeparator) then
EtcPath := EtcPath + DirectorySeparator;
{$ELSE ETC_BY_ENV}
{$WARNING Support for finding /etc/ directory not implemented for this platform!}
{$ENDIF ETC_BY_ENV}
{$ENDIF UNIX_ETC}
If FileExists (EtcPath + SHostsFile) then
HostsList := ProcessHosts (EtcPath + SHostsFile);
CheckResolveFileAge:=False;
If FileExists(SResolveFile) then
GetDNsservers(SResolveFile);
If FileExists(EtcPath + SResolveFile) then
GetDNsservers(EtcPath + SResolveFile)
{$IFDEF OS2}
else if FileExists(EtcPath + SResolveFile2) then
GetDNsservers(EtcPath + SResolveFile2)
{$ENDIF OS2}
;
end;
Procedure DoneResolver;