diff --git a/.gitattributes b/.gitattributes index 4bb706c497..fb6ac93614 100644 --- a/.gitattributes +++ b/.gitattributes @@ -1618,6 +1618,7 @@ packages/base/netdb/hsh.inc svneol=native#text/plain packages/base/netdb/ip6test.pp svneol=native#text/plain packages/base/netdb/netdb.pp svneol=native#text/plain packages/base/netdb/testdns.pp svneol=native#text/plain +packages/base/netdb/testhosts.pp svneol=native#text/plain packages/base/netdb/testhst.pp svneol=native#text/plain packages/base/netdb/testnet.pp svneol=native#text/plain packages/base/netdb/testproto.pp svneol=native#text/plain diff --git a/packages/base/netdb/Makefile b/packages/base/netdb/Makefile index d10b289c14..c66e9ec8e2 100644 --- a/packages/base/netdb/Makefile +++ b/packages/base/netdb/Makefile @@ -1,5 +1,5 @@ # -# Don't edit, this file is generated by FPCMake Version 2.0.0 [2006/04/23] +# Don't edit, this file is generated by FPCMake Version 2.0.0 [2006/05/20] # default: all MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd x86_64-win64 arm-linux arm-palmos arm-wince powerpc64-linux @@ -350,7 +350,7 @@ ifeq ($(FULL_TARGET),powerpc64-linux) override TARGET_UNITS+=uriparser netdb endif ifeq ($(FULL_TARGET),i386-linux) -override TARGET_EXAMPLES+=testuri testdns testhst testsvc testnet +override TARGET_EXAMPLES+=testuri testdns testhst testsvc testnet testhosts endif ifeq ($(FULL_TARGET),i386-go32v2) override TARGET_EXAMPLES+=testuri @@ -362,16 +362,16 @@ ifeq ($(FULL_TARGET),i386-os2) override TARGET_EXAMPLES+=testuri endif ifeq ($(FULL_TARGET),i386-freebsd) -override TARGET_EXAMPLES+=testuri testdns testhst testsvc testnet +override TARGET_EXAMPLES+=testuri testdns testhst testsvc testnet testhosts endif ifeq ($(FULL_TARGET),i386-beos) override TARGET_EXAMPLES+=testuri endif ifeq ($(FULL_TARGET),i386-netbsd) -override TARGET_EXAMPLES+=testuri testdns testhst testsvc testnet +override TARGET_EXAMPLES+=testuri testdns testhst testsvc testnet testhosts endif ifeq ($(FULL_TARGET),i386-solaris) -override TARGET_EXAMPLES+=testuri testdns testhst testsvc testnet +override TARGET_EXAMPLES+=testuri testdns testhst testsvc testnet testhosts endif ifeq ($(FULL_TARGET),i386-qnx) override TARGET_EXAMPLES+=testuri @@ -380,13 +380,13 @@ ifeq ($(FULL_TARGET),i386-netware) override TARGET_EXAMPLES+=testuri endif ifeq ($(FULL_TARGET),i386-openbsd) -override TARGET_EXAMPLES+=testuri testdns testhst testsvc testnet +override TARGET_EXAMPLES+=testuri testdns testhst testsvc testnet testhosts endif ifeq ($(FULL_TARGET),i386-wdosx) override TARGET_EXAMPLES+=testuri endif ifeq ($(FULL_TARGET),i386-darwin) -override TARGET_EXAMPLES+=testuri testdns testhst testsvc testnet +override TARGET_EXAMPLES+=testuri testdns testhst testsvc testnet testhosts endif ifeq ($(FULL_TARGET),i386-emx) override TARGET_EXAMPLES+=testuri @@ -401,13 +401,13 @@ ifeq ($(FULL_TARGET),i386-wince) override TARGET_EXAMPLES+=testuri endif ifeq ($(FULL_TARGET),m68k-linux) -override TARGET_EXAMPLES+=testuri testdns testhst testsvc testnet +override TARGET_EXAMPLES+=testuri testdns testhst testsvc testnet testhosts endif ifeq ($(FULL_TARGET),m68k-freebsd) -override TARGET_EXAMPLES+=testuri testdns testhst testsvc testnet +override TARGET_EXAMPLES+=testuri testdns testhst testsvc testnet testhosts endif ifeq ($(FULL_TARGET),m68k-netbsd) -override TARGET_EXAMPLES+=testuri testdns testhst testsvc testnet +override TARGET_EXAMPLES+=testuri testdns testhst testsvc testnet testhosts endif ifeq ($(FULL_TARGET),m68k-amiga) override TARGET_EXAMPLES+=testuri @@ -416,46 +416,46 @@ ifeq ($(FULL_TARGET),m68k-atari) override TARGET_EXAMPLES+=testuri endif ifeq ($(FULL_TARGET),m68k-openbsd) -override TARGET_EXAMPLES+=testuri testdns testhst testsvc testnet +override TARGET_EXAMPLES+=testuri testdns testhst testsvc testnet testhosts endif ifeq ($(FULL_TARGET),m68k-palmos) override TARGET_EXAMPLES+=testuri endif ifeq ($(FULL_TARGET),powerpc-linux) -override TARGET_EXAMPLES+=testuri testdns testhst testsvc testnet +override TARGET_EXAMPLES+=testuri testdns testhst testsvc testnet testhosts endif ifeq ($(FULL_TARGET),powerpc-netbsd) -override TARGET_EXAMPLES+=testuri testdns testhst testsvc testnet +override TARGET_EXAMPLES+=testuri testdns testhst testsvc testnet testhosts endif ifeq ($(FULL_TARGET),powerpc-macos) override TARGET_EXAMPLES+=testuri endif ifeq ($(FULL_TARGET),powerpc-darwin) -override TARGET_EXAMPLES+=testuri testdns testhst testsvc testnet +override TARGET_EXAMPLES+=testuri testdns testhst testsvc testnet testhosts endif ifeq ($(FULL_TARGET),powerpc-morphos) override TARGET_EXAMPLES+=testuri endif ifeq ($(FULL_TARGET),sparc-linux) -override TARGET_EXAMPLES+=testuri testdns testhst testsvc testnet +override TARGET_EXAMPLES+=testuri testdns testhst testsvc testnet testhosts endif ifeq ($(FULL_TARGET),sparc-netbsd) -override TARGET_EXAMPLES+=testuri testdns testhst testsvc testnet +override TARGET_EXAMPLES+=testuri testdns testhst testsvc testnet testhosts endif ifeq ($(FULL_TARGET),sparc-solaris) -override TARGET_EXAMPLES+=testuri testdns testhst testsvc testnet +override TARGET_EXAMPLES+=testuri testdns testhst testsvc testnet testhosts endif ifeq ($(FULL_TARGET),x86_64-linux) -override TARGET_EXAMPLES+=testuri testdns testhst testsvc testnet +override TARGET_EXAMPLES+=testuri testdns testhst testsvc testnet testhosts endif ifeq ($(FULL_TARGET),x86_64-freebsd) -override TARGET_EXAMPLES+=testuri testdns testhst testsvc testnet +override TARGET_EXAMPLES+=testuri testdns testhst testsvc testnet testhosts endif ifeq ($(FULL_TARGET),x86_64-win64) override TARGET_EXAMPLES+=testuri endif ifeq ($(FULL_TARGET),arm-linux) -override TARGET_EXAMPLES+=testuri testdns testhst testsvc testnet +override TARGET_EXAMPLES+=testuri testdns testhst testsvc testnet testhosts endif ifeq ($(FULL_TARGET),arm-palmos) override TARGET_EXAMPLES+=testuri @@ -464,7 +464,7 @@ ifeq ($(FULL_TARGET),arm-wince) override TARGET_EXAMPLES+=testuri endif ifeq ($(FULL_TARGET),powerpc64-linux) -override TARGET_EXAMPLES+=testuri testdns testhst testsvc testnet +override TARGET_EXAMPLES+=testuri testdns testhst testsvc testnet testhosts endif override INSTALL_FPCPACKAGE=y ifdef REQUIRE_UNITSDIR diff --git a/packages/base/netdb/Makefile.fpc b/packages/base/netdb/Makefile.fpc index f3ec3c4950..b9ac721844 100644 --- a/packages/base/netdb/Makefile.fpc +++ b/packages/base/netdb/Makefile.fpc @@ -14,12 +14,12 @@ units_openbsd=netdb units_netbsd=netdb units_darwin=netdb units_solaris=netdb -examples_linux=testdns testhst testsvc testnet -examples_freebsd=testdns testhst testsvc testnet -examples_openbsd=testdns testhst testsvc testnet -examples_netbsd=testdns testhst testsvc testnet -examples_darwin=testdns testhst testsvc testnet -examples_solaris=testdns testhst testsvc testnet +examples_linux=testdns testhst testsvc testnet testhosts +examples_freebsd=testdns testhst testsvc testnet testhosts +examples_openbsd=testdns testhst testsvc testnet testhosts +examples_netbsd=testdns testhst testsvc testnet testhosts +examples_darwin=testdns testhst testsvc testnet testhosts +examples_solaris=testdns testhst testsvc testnet testhosts examples=testuri [require] diff --git a/packages/base/netdb/netdb.pp b/packages/base/netdb/netdb.pp index eb8a38e773..f1440fc4c3 100644 --- a/packages/base/netdb/netdb.pp +++ b/packages/base/netdb/netdb.pp @@ -63,24 +63,35 @@ Type Addr : THostAddr; Aliases : String; end; + PHostEntry = ^THostEntry; + THostEntryArray = Array of THostEntry; TNetworkEntry = Record Name : String; Addr : TNetAddr; Aliases : String; end; + PNetworkEntry = ^TNetworkEntry; TProtocolEntry = Record Name : String; Number : integer; Aliases : String; end; + PProtocolEntry = ^TProtocolEntry; + + PHostListEntry = ^THostListEntry; + THostListEntry = Record + Entry : THostEntry; + Next : PHostListEntry; + end; Var DNSServers : TDNSServerArray; DNSServerCount : Integer; DefaultDomainList : String; CheckResolveFileAge : Boolean; + CheckHostsFileAge : Boolean; TimeOutS,TimeOutMS : Longint; @@ -111,6 +122,11 @@ Function GetProtocolByName(ProtoName: String; Var H : TProtocolEntry) : boolean Function GetProtocolByNumber(proto: Integer; Var H : TProtocolEntry) : boolean; + +Function ProcessHosts(FileName : String) : PHostListEntry; +Function FreeHostsList(var List : PHostListEntry) : Integer; +Procedure HostsListToArray(var List : PHostListEntry; Var Hosts : THostEntryArray; FreeList : Boolean); + Implementation uses @@ -162,13 +178,250 @@ Type RDLength : Word; 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-I); + Delete(Line,1,J); +end; + +Function StripComment(var L : String) : Boolean; + Var - ResolveFileAge : Longint; - ResolveFileName : String; + i : Integer; + +begin + I:=Pos('#',L); + If (I<>0) then + L:=Copy(L,1,I-1) + else + begin + I:=Pos(';',L); + If (I<>0) then + L:=Copy(L,1,I-1) + end; + Result:=Length(L)>0; +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; + +{ --------------------------------------------------------------------- + hosts processing + ---------------------------------------------------------------------} + +Function GetAddr(Var L : String; Var Addr : THostAddr) : Boolean; + +Var + S : String; + i,p,a : Integer; + +begin + Result:=True; + S:=NextWord(L); + Addr:=StrToNetAddr(S); + Writeln(s,'->',Addr.s_bytes[1],'.',Addr.s_bytes[2],'.',Addr.s_bytes[3],'.',Addr.s_bytes[4]); + Result:=Addr.s_bytes[1]<>0; +end; + + +Function FillHostEntry (Var Entry : THostEntry; L: String) : boolean; + +Var + H : String; + +begin + Repeat + H:=NextWord(L); + If (H<>'') then + if (Entry.Name='') then + Entry.Name:=H + else + begin + If (Entry.Aliases<>'') then + Entry.Aliases:=Entry.Aliases+','; + Entry.Aliases:=Entry.Aliases+H; + end; + until (H=''); +end; + +Function ProcessHosts(FileName : String) : PHostListEntry; + +Var + F : Text; + L : String; + A : THostAddr; + T : PHostListEntry; + +begin + Result:=Nil; + Assign(F,FileName); + {$I-} + Reset(F); + {$I+}; + If (IOResult<>0) then + Exit; + Try + While Not EOF(F) do + begin + Readln(F,L); + If StripComment(L) then + begin + If GetAddr(L,A) then + begin + T:=New(PHostListEntry); + T^.Entry.Addr:=A; + FillHostEntry(T^.Entry,L); + T^.Next:=Result; + Result:=T; + end; + end; + end; + Finally + Close(F); + end; +end; + +{ Internal lookup, used in GetHostByName and friends. } + +Var + HostsList : PHostListEntry = Nil; + HostsFileAge : Longint; + HostsFileName : String; + +Function FreeHostsList(var List : PHostListEntry) : Integer; + +Var + P : PHostListEntry; + +begin + Result:=0; + While (List<>Nil) do + begin + Inc(Result); + P:=List^.Next; + FreeMem(List); + List:=P; + end; +end; + +Procedure HostsListToArray(var List : PHostListEntry; Var Hosts : THostEntryArray; FreeList : Boolean); + +Var + P : PHostListEntry; + Len : Integer; + +begin + Len:=0; + P:=List; + While P<> Nil do + begin + Inc(Len); + P:=P^.Next; + end; + SetLength(Hosts,Len); + If (Len>0) then + begin + Len:=0; + P:=List; + While (P<>Nil) do + begin + Hosts[Len]:=P^.Entry; + P:=P^.Next; + Inc(Len); + end; + end; + If FreeList then + FreeHostsList(List); +end; + +Procedure CheckHostsFile; + +Var + F : Integer; + +begin + If CheckHostsFileAge then + begin + F:=FileAge(SHostsFile); + If HostsFileAgeNil) do + begin + HE:=P^.Entry; + If (N<>'') then + Result:=MatchNameOrAlias(N,HE.Name,HE.Aliases) + else + Result:=Cardinal(hosttonet(Addr))=Cardinal(HE.Addr); + P:=P^.Next; + end; + If Result then + begin + H.Name:=HE.Name; + H.Addr:=nettohost(HE.Addr); + H.Aliases:=HE.Aliases; + end; +end; { --------------------------------------------------------------------- Resolve.conf handling ---------------------------------------------------------------------} + +Var + ResolveFileAge : Longint; + ResolveFileName : String; Function GetDNSServers(Fn : String) : Integer; @@ -177,7 +430,8 @@ Var L : String; I : Integer; H : THostAddr; - + E : THostEntry; + Function CheckDirective(Dir : String) : Boolean; Var @@ -207,28 +461,25 @@ begin While not EOF(R) do begin Readln(R,L); - I:=Pos('#',L); - If (I<>0) then - L:=Copy(L,1,I-1) - else - begin - I:=Pos(';',L); - If (I<>0) then - L:=Copy(L,1,I-1) - end; - If CheckDirective('nameserver') then - begin - H:=HostToNet(StrToHostAddr(L)); - If H.s_bytes[1]<>0 then + if StripComment(L) then + If CheckDirective('nameserver') then begin - Inc(Result); - DNSServers[Result]:=H; - end; - end - else if CheckDirective('domain') then - DefaultDomainList:=L - else if CheckDirective('search') then - DefaultDomainList:=L; + H:=HostToNet(StrToHostAddr(L)); + If (H.s_bytes[1]<>0) then + begin + Inc(Result); + DNSServers[Result]:=H; + end + else if FindHostEntryInHostsFile(L,H,E) then + begin + Inc(Result); + DNSServers[Result]:=E.Addr; + end; + end + else if CheckDirective('domain') then + DefaultDomainList:=L + else if CheckDirective('search') then + DefaultDomainList:=L; end; Finally Close(R); @@ -794,133 +1045,6 @@ begin 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-I); - 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; - -begin - Result:=False; - Repeat - ReadLn(F,Line); - StripComment(Line); - S:=NextWord(Line); - If (S<>'') then - begin - H.Addr:=StrTonetAddr(S); // endianness problem here. (fixed) - if (H.Addr.s_bytes[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(hosttonet(Addr))=Cardinal(HE.Addr); - end; - Close(f); - If Result then - begin - H.Name:=HE.Name; - H.Addr:=nettohost(HE.Addr); - H.Aliases:=HE.Aliases; - end; - end; - end; -end; //const NoAddress : in_addr = (s_addr: 0); @@ -937,6 +1061,7 @@ begin Result:=FindHostEntryInHostsFile('',Addr,H); end; + { --------------------------------------------------------------------- /etc/protocols handling. ---------------------------------------------------------------------} @@ -1232,11 +1357,23 @@ Var begin TimeOutS :=5; TimeOutMS:=0; + CheckHostsFileAge:=False; + If FileExists(SHostsFile) then + HostsList:=ProcessHosts(SHostsFile); CheckResolveFileAge:=False; If FileExists(SResolveFile) then GetDNsservers(SResolveFile); end; +Procedure DoneResolver; + begin + FreeHostsList(HostsList); +end; + + +Initialization InitResolver; +Finalization + DoneResolver; end. diff --git a/packages/base/netdb/testhosts.pp b/packages/base/netdb/testhosts.pp new file mode 100644 index 0000000000..c5deb3a74b --- /dev/null +++ b/packages/base/netdb/testhosts.pp @@ -0,0 +1,44 @@ +{$mode objfpc} +{$h+} +program testhosts; + +uses sockets,netdb; + +Const +{$ifdef unix} + hosts = '/etc/hosts'; +{$else} +{$ifdef win32} + hosts = 'c:\windows\system32\drivers\etc\hosts'; +{$else} + hosts = 'hosts'; { Fallback !! } +{$endif} +{$endif} + +var + L,P : PHostListEntry; + I : Integer; + +begin + L:=ProcessHosts(Hosts); + Try + P:=L; + I:=0; + While (P<>Nil) do + begin + With P^ do + begin + Inc(I); + Write(i:3,' Address : ',HostAddrToStr(NetToHost(P^.entry.addr)):15); + Write(' hostname : ',P^.entry.Name); + If (P^.entry.Aliases<>'') then + Writeln(' Aliases : ',P^.entry.Aliases) + else + Writeln; + P:=P^.next; + end; + end + finally + FreeHostslist(L); + end; +end. \ No newline at end of file