+ Fixed bug #4821 and added test

git-svn-id: trunk@3810 -

.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

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

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_linux=testdns testhst testsvc testnet testhosts
-examples_freebsd=testdns testhst testsvc testnet
+examples_freebsd=testdns testhst testsvc testnet testhosts
-examples_openbsd=testdns testhst testsvc testnet
+examples_openbsd=testdns testhst testsvc testnet testhosts
-examples_netbsd=testdns testhst testsvc testnet
+examples_netbsd=testdns testhst testsvc testnet testhosts
-examples_darwin=testdns testhst testsvc testnet
+examples_darwin=testdns testhst testsvc testnet testhosts
-examples_solaris=testdns testhst testsvc testnet
+examples_solaris=testdns testhst testsvc testnet testhosts
 examples=testuri
 
 [require]

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,14 +178,251 @@ Type
     RDLength : Word;
   end;
 
+{ ---------------------------------------------------------------------
+    Some Parsing routines
+  ---------------------------------------------------------------------}
+
+Const 
+  Whitespace = [' ',#9];
+
+Function NextWord(Var Line : String) : String;
+
 Var 
-  ResolveFileAge  : Longint;
+  I,J : Integer;
-  ResolveFileName : String;
+
+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
+  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 HostsFileAge<F then
+      begin
+      // Rescan.
+      FreeHostsList(HostsList);
+      HostsList:=ProcessHosts(SHostsFile);
+      HostsFileAge:=F;
+      end;
+    end;  
+end;
+
+Function FindHostEntryInHostsFile(N: String; Addr: THostAddr; Var H : THostEntry) : boolean;
+
+Var
+  F : Text;
+  HE : THostEntry;
+  P : PHostListEntry;
+  
+begin
+  Result:=False;
+  CheckHostsFile;
+  P:=HostsList;
+  While (Not Result) and (P<>Nil) 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;
 
 Var
@@ -177,6 +430,7 @@ Var
   L : String;
   I : Integer;
   H : THostAddr;
+  E : THostEntry;
   
   Function CheckDirective(Dir : String) : Boolean;
   
@@ -207,22 +461,19 @@ begin
     While not EOF(R) do
       begin
       Readln(R,L);
-      I:=Pos('#',L);
+      if StripComment(L) then
-      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 (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
@@ -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.

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.