Browse Source

--- Merging r32726 into '.':
U packages/fcl-net/src/cnetdb.pp
U packages/fcl-net/fpmake.pp
--- Recording mergeinfo for merge of r32726 into '.':
U .
--- Merging r33094 into '.':
U packages/fcl-net/src/ssockets.pp
--- Recording mergeinfo for merge of r33094 into '.':
G .
--- Merging r33166 into '.':
G packages/fcl-net/src/ssockets.pp
--- Recording mergeinfo for merge of r33166 into '.':
G .
--- Merging r33332 into '.':
G packages/fcl-net/src/cnetdb.pp
--- Recording mergeinfo for merge of r33332 into '.':
G .

# revisions: 32726,33094,33166,33332

git-svn-id: branches/fixes_3_0@33395 -

marco 9 years ago
parent
commit
ae2cab9b58
3 changed files with 189 additions and 78 deletions
  1. 1 1
      packages/fcl-net/fpmake.pp
  2. 103 64
      packages/fcl-net/src/cnetdb.pp
  3. 85 13
      packages/fcl-net/src/ssockets.pp

+ 1 - 1
packages/fcl-net/fpmake.pp

@@ -70,7 +70,7 @@ begin
         end;
     T.ResourceStrings := True;
 
-    T:=P.Targets.AddUnit('cnetdb.pp',[linux,freebsd]);
+    T:=P.Targets.AddUnit('cnetdb.pp',[linux,freebsd,solaris]);
 
     P.ExamplePath.Add('examples');
     P.Targets.AddExampleProgram('examples/ip6test.pp');

+ 103 - 64
packages/fcl-net/src/cnetdb.pp

@@ -75,66 +75,105 @@ const
 // (left in h_errno).
 
 const
-   NETDB_INTERNAL  = -(1);	{ see errno }	
-   NETDB_SUCCESS   = 0;		{ no problem  }                                       	
-   HOST_NOT_FOUND  = 1;		{ Authoritative Answer Host not found  }              	
-   TRY_AGAIN 	   = 2;		{ Non-Authoritative Host not found, or SERVERFAIL  }  	
-   NO_RECOVERY     = 3;		{ Non recoverable errors, FORMERR, REFUSED, NOTIMP  }   	
-   NO_DATA 	   = 4;		{ Valid name, no data record of requested type  }     	
-   NO_ADDRESS = NO_DATA;        { no address, look for MX record  }
-{
-  return codes from getaddrinfo()
-}
-
-   EAI_AGAIN      = 2;          { address family for hostname not supported }
-   EAI_BADFLAGS   = 3;          { invalid value for ai_flags  }
-   EAI_FAIL       = 4;		{ non-recoverable failure in name resolution  }
-   EAI_FAMILY     = 5;          { ai_family not supported  }
-   EAI_MEMORY     = 6;          { memory allocation failure  }
-   EAI_NONAME     = 8;          { hostname nor servname provided, or not known  }
-   EAI_SERVICE    = 9;          { servname not supported for ai_socktype  } 
-   EAI_SOCKTYPE   = 10;         { ai_socktype not supported  }
-   EAI_SYSTEM     = 11;         { system error returned in errno  }
-   EAI_BADHINTS   = 12;
-   EAI_PROTOCOL   = 13;
-   EAI_MAX = 14;
-{
- * Flag values for getaddrinfo()
-  }
-{ get address to use bind()  }
-   AI_PASSIVE = $00000001;
-{ fill ai_canonname  }
-   AI_CANONNAME = $00000002;
-{ prevent host name resolution  }
-   AI_NUMERICHOST = $00000004;
-{ prevent service name resolution  }
-   AI_NUMERICSERV = $00000008;
-{ IPv6 and IPv4-mapped (with AI_V4MAPPED)  }
-   AI_ALL = $00000100;
-{ accept IPv4-mapped if kernel supports  }
-   AI_V4MAPPED_CFG = $00000200;
-{ only if any address is assigned  }
-   AI_ADDRCONFIG = $00000400;
-{ accept IPv4-mapped IPv6 address  }
-   AI_V4MAPPED = $00000800;
-{ special recommended flags for getipnodebyname  }
-   AI_DEFAULT = AI_V4MAPPED_CFG or AI_ADDRCONFIG;
-{ valid flags for addrinfo (not a standard def, apps should not use it)  }
-   AI_MASK = AI_PASSIVE or AI_CANONNAME or AI_NUMERICHOST or AI_NUMERICSERV or AI_ADDRCONFIG;
 
-{
- * Constants for getnameinfo()
-  }
-   NI_MAXHOST = 1025;
-   NI_MAXSERV = 32;
-{
- * Flag values for getnameinfo()
-  }
-   NI_NOFQDN = $00000001;
-   NI_NUMERICHOST = $00000002;
-   NI_NAMEREQD = $00000004;
-   NI_NUMERICSERV = $00000008;
-   NI_DGRAM = $00000010;
+  NETDB_INTERNAL  = -(1);    { see errno }
+  NETDB_SUCCESS   = 0;       { no problem  }
+  HOST_NOT_FOUND  = 1;       { Authoritative Answer Host not found  }
+  TRY_AGAIN       = 2;       { Non-Authoritative Host not found, or SERVERFAIL  }
+  NO_RECOVERY     = 3;       { Non recoverable errors, FORMERR, REFUSED, NOTIMP  }
+  NO_DATA         = 4;       { Valid name, no data record of requested type  }
+  NO_ADDRESS      = NO_DATA; { no address, look for MX record  }
+
+  {$IF DEFINED(FREEBSD)}
+
+    AI_PASSIVE     = $00000001;
+    AI_CANONNAME   = $00000002;
+    AI_NUMERICHOST = $00000004;
+    AI_V4MAPPED    = $00000008;
+    AI_ALL         = $00000010;
+    AI_ADDRCONFIG  = $00000020;
+    AI_DEFAULT     = (AI_V4MAPPED OR AI_ADDRCONFIG);
+
+    EAI_ADDRFAMILY = 1; (* address family for hostname not supported *)
+    EAI_AGAIN      = 2; (* temporary failure in name resolution *)
+    EAI_BADFLAGS   = 3; (* invalid value for ai_flags *)
+    EAI_FAIL       = 4; (* non-recoverable failure in name resolution *)
+    EAI_FAMILY     = 5; (* ai_family not supported *)
+    EAI_MEMORY     = 6; (* memory allocation failure *)
+    EAI_NODATA     = 7; (* no address associated with hostname *)
+    EAI_NONAME     = 8; (* hostname nor servname provided, or not known *)
+    EAI_SERVICE    = 9; (* servname not supported for ai_socktype *)
+    EAI_SOCKTYPE   = 10; (* ai_socktype not supported *)
+    EAI_SYSTEM     = 11; (* system error returned in errno *)
+    EAI_BADHINTS   = 12;
+    EAI_PROTOCOL   = 13;
+    EAI_MAX        = 14;
+
+  {$ELSE}
+
+    (* Possible values for `ai_flags' field in `addrinfo' structure.  *)
+
+    AI_PASSIVE                  = $0001; (* Socket address is intended for `bind'.  *)
+    AI_CANONNAME                = $0002; (* Request for canonical name.  *)
+    AI_NUMERICHOST              = $0004; (* Don't use name resolution.  *)
+    AI_V4MAPPED                 = $0008; (* IPv4 mapped addresses are acceptable.  *)
+    AI_ALL                      = $0010; (* Return IPv4 mapped and IPv6 addresses.  *)
+    AI_ADDRCONFIG               = $0020; (* Use configuration of this host to choose returned address type..  *)
+    AI_IDN                      = $0040; (* IDN encode input (assuming it is encoded in the current locale's character set) before looking it up.  *)
+    AI_CANONIDN                 = $0080; (* Translate canonical name from IDN format.  *)
+    AI_IDN_ALLOW_UNASSIGNED     = $0100; (* Don't reject unassigned Unicode code points.  *)
+    AI_IDN_USE_STD3_ASCII_RULES = $0200; (* Validate strings according to STD3 rules.  *)
+    AI_NUMERICSERV              = $0400; (* Don't use name resolution.  *)
+
+    (* Error values for `getaddrinfo' function.  *)
+
+    EAI_BADFLAGS    = -1;   (* Invalid value for `ai_flags' field.  *)
+    EAI_NONAME      = -2;   (* NAME or SERVICE is unknown.  *)
+    EAI_AGAIN       = -3;   (* Temporary failure in name resolution.  *)
+    EAI_FAIL        = -4;   (* Non-recoverable failure in name res.  *)
+    EAI_NODATA      = -5;   (* No address associated with NAME.  *)
+    EAI_FAMILY      = -6;   (* `ai_family' not supported.  *)
+    EAI_SOCKTYPE    = -7;   (* `ai_socktype' not supported.  *)
+    EAI_SERVICE     = -8;   (* SERVICE not supported for `ai_socktype'.  *)
+    EAI_ADDRFAMILY  = -9;   (* Address family for NAME not supported.  *)
+    EAI_MEMORY      = -10;  (* Memory allocation failure.  *)
+    EAI_SYSTEM      = -11;  (* System error returned in `errno'.  *)
+    EAI_OVERFLOW    = -12;  (* Argument buffer overflow.  *)
+    EAI_INPROGRESS  = -100; (* Processing request in progress.  *)
+    EAI_CANCELED    = -101; (* Request canceled.  *)
+    EAI_NOTCANCELED = -102; (* Request not canceled.  *)
+    EAI_ALLDONE     = -103; (* All requests done.  *)
+    EAI_INTR        = -104; (* Interrupted by a signal.  *)
+    EAI_IDN_ENCODE  = -105; (* IDN encoding failed.  *)
+
+  {$ENDIF}
+
+  (* Constants for getnameinfo() *)
+
+  NI_MAXHOST = 1025;
+  NI_MAXSERV = 32;
+
+  (* Flag values for getnameinfo() *)
+
+  {$IF DEFINED(FREEBSD)}
+
+    NI_NOFQDN       = $00000001;
+    NI_NUMERICHOST  = $00000002;
+    NI_NAMEREQD     = $00000004;
+    NI_NUMERICSERV  = $00000008;
+    NI_DGRAM        = $00000010;
+    NI_NUMERICSCOPE = $00000020;
+
+  {$ELSE}
+
+    NI_NUMERICHOST = 1;
+    NI_NUMERICSERV = 2;
+    NI_NOFQDN      = 4;
+    NI_NAMEREQD    = 8;
+    NI_DGRAM       = 16;
+
+  {$ENDIF}
+
 {
  * Scope delimit character
   }
@@ -194,11 +233,11 @@ type
 {$if defined(LINUX) or defined(OPENBSD)}
 {$define FIRST_ADDR_THEN_CANONNAME}
 {$endif}
-{$if defined(FREEBSD) or defined(NETBSD) or defined(DRAGONFLY)}
+{$if defined(FREEBSD) or defined(NETBSD) or defined(DRAGONFLY) or defined(SOLARIS)}
 {$define FIRST_CANONNAME_THEN_ADDR}
 {$endif}
 {$if not defined(FIRST_CANONNAME_THEN_ADDR) and not defined(FIRST_ADDR_THEN_CANONNAME)}
-{$error fatal 'Please consult the netdh.h file for your system to determine the order of ai_addr and ai_canonname'}
+{$error fatal 'Please consult the netdb.h file for your system to determine the order of ai_addr and ai_canonname'}
 {$endif} 
 
   PAddrInfo = ^addrinfo;
@@ -268,10 +307,10 @@ procedure sethostent(i: cInt); cdecl; external LIB_C name 'sethostent';
 
 procedure setnetent(stayopen: cInt); cdecl; external LIB_C name 'setnetent';
 procedure setprotoent(stayopen: cInt); cdecl; external LIB_C name 'setprotoent';
-function  getaddrinfo(hostname, servname: PChar;
-                     hints: PAddrInfo; res: PPAddrInfo): cInt; cdecl; external LIB_C name 'getaddrinfo';
+function  getaddrinfo(name, service: PChar; hints: PAddrInfo;
+                      res: PPAddrInfo): cInt; cdecl; external LIB_C name 'getaddrinfo';
 function  getnameinfo(sa: PSockAddr; salen: TSockLen; host: PChar; hostlen: TSize;
-                     serv: PChar; servlen: TSize; flags: cInt): cInt; cdecl; external LIB_C name 'getnameinfo';
+                      serv: PChar; servlen: TSize; flags: cInt): cInt; cdecl; external LIB_C name 'getnameinfo';
 procedure freeaddrinfo(ai: PAddrInfo); cdecl; external LIB_C name 'freeaddrinfo';
 function  gai_strerror(ecode: cInt): PChar; cdecl; external LIB_C name 'gai_strerror';
 procedure setnetgrent(netgroup: PChar); cdecl; external LIB_C name 'setnetgrent';

+ 85 - 13
packages/fcl-net/src/ssockets.pp

@@ -29,7 +29,8 @@ type
     seListenFailed,
     seConnectFailed,
     seAcceptFailed,
-    seAcceptWouldBlock);
+    seAcceptWouldBlock,
+    seIOTimeOut);
 
   TSocketOption = (soDebug,soReuseAddr,soKeepAlive,soDontRoute,soBroadcast,
                    soOOBinline);
@@ -79,11 +80,13 @@ type
     FSocketOptions : TSocketOptions;
     FWriteFlags: Integer;
     FHandler : TSocketHandler;
+    FIOTimeout : Integer;
     function GetLastError: Integer;
     Procedure GetSockOptions;
     Procedure SetSocketOptions(Value : TSocketOptions);
     function GetLocalAddress: TSockAddr;
     function GetRemoteAddress: TSockAddr;
+    procedure SetIOTimeout(AValue: Integer);
   Public
     Constructor Create (AHandle : Longint; AHandler : TSocketHandler = Nil);virtual;
     destructor Destroy; override;
@@ -97,6 +100,7 @@ type
     Property LastError : Integer Read GetLastError;
     Property ReadFlags : Integer Read FReadFlags Write FReadFlags;
     Property WriteFlags : Integer Read FWriteFlags Write FWriteFlags;
+    Property IOTimeout : Integer read FIOTimeout Write SetIOTimeout;
   end;
 
   TConnectEvent = Procedure (Sender : TObject; Data : TSocketStream) Of Object;
@@ -194,6 +198,7 @@ type
   Protected
     Procedure Bind; Override;
     Function Accept : Longint;override;
+    function GetConnection: TSocketStream; override;
     Function SockToStream (ASocket : Longint) : TSocketStream;Override;
     Procedure Close; override;
   Public
@@ -253,7 +258,9 @@ resourcestring
   strSocketConnectFailed = 'Connect to %s failed.';
   strSocketAcceptFailed = 'Could not accept a client connection on socket: %d, error %d';
   strSocketAcceptWouldBlock = 'Accept would block on socket: %d';
+  strSocketIOTimeOut = 'Failed to set IO Timeout to %d';
   strErrNoStream = 'Socket stream not assigned';
+  
 { TSocketHandler }
 
 Procedure TSocketHandler.SetSocket(const AStream: TSocketStream);
@@ -349,13 +356,14 @@ var
 begin
   Code := ACode;
   case ACode of
-    seHostNotFound  : s := strHostNotFound;
-    seCreationFailed: s := strSocketCreationFailed;
-    seBindFailed    : s := strSocketBindFailed;
-    seListenFailed  : s := strSocketListenFailed;
-    seConnectFailed : s := strSocketConnectFailed;
-    seAcceptFailed  : s := strSocketAcceptFailed;
-    seAcceptWouldBLock : S:= strSocketAcceptWouldBlock;
+    seHostNotFound     : s := strHostNotFound;
+    seCreationFailed   : s := strSocketCreationFailed;
+    seBindFailed       : s := strSocketBindFailed;
+    seListenFailed     : s := strSocketListenFailed;
+    seConnectFailed    : s := strSocketConnectFailed;
+    seAcceptFailed     : s := strSocketAcceptFailed;
+    seAcceptWouldBLock : S := strSocketAcceptWouldBlock;
+    seIOTimeout        : S := strSocketIOTimeOut;
   end;
   s := Format(s, MsgArgs);
   inherited Create(s);
@@ -385,9 +393,28 @@ begin
   inherited Destroy;
 end;
 
-Procedure TSocketStream.GetSockOptions;
-
-begin
+procedure TSocketStream.GetSockOptions;
+{$ifdef windows}
+var
+  opt: DWord;
+  olen: tsocklen;
+{$endif windows}
+{$ifdef unix}
+var
+  time: ttimeval;
+  olen: tsocklen;
+{$endif unix}
+begin
+  {$ifdef windows}
+  olen:=4;
+  if fpgetsockopt(Handle, SOL_SOCKET, SO_RCVTIMEO, @opt, @olen) = 0 then
+    FIOTimeout:=opt;
+  {$endif windows}
+  {$ifdef unix}
+  olen:=sizeof(time);
+  if fpgetsockopt(Handle, SOL_SOCKET, SO_RCVTIMEO, @time, @olen) = 0 then
+    FIOTimeout:=(time.tv_sec*1000)+(time.tv_usec div 1000);
+  {$endif}
 end;
 
 function TSocketStream.GetLastError: Integer;
@@ -436,6 +463,37 @@ begin
     FillChar(Result, SizeOf(Result), 0);
 end;
 
+procedure TSocketStream.SetIOTimeout(AValue: Integer);
+
+Var
+  E : Boolean;
+{$ifdef windows}
+  opt: DWord;
+{$endif windows}
+{$ifdef unix}
+  time: ttimeval;
+{$endif unix}
+
+begin
+  if FIOTimeout=AValue then Exit;
+  FIOTimeout:=AValue;
+
+  {$ifdef windows}
+  opt := AValue;
+  E:=fpsetsockopt(Handle, SOL_SOCKET, SO_RCVTIMEO, @opt, 4)<>0;
+  if not E then
+    E:=fpsetsockopt(Handle, SOL_SOCKET, SO_SNDTIMEO, @opt, 4)<>0;
+  {$endif windows}
+  {$ifdef unix}
+  time.tv_sec:=avalue div 1000;
+  time.tv_usec:=(avalue mod 1000) * 1000;
+  E:=fpsetsockopt(Handle, SOL_SOCKET, SO_RCVTIMEO, @time, sizeof(time))<>0;
+  if not E then
+    E:=fpsetsockopt(Handle, SOL_SOCKET, SO_SNDTIMEO, @time, sizeof(time))<>0;
+  {$endif}
+  if E then
+    Raise ESocketError.Create(seIOTimeout,[AValue]);
+end;
 
 { ---------------------------------------------------------------------
     TSocketServer
@@ -509,11 +567,9 @@ Function TInetServer.GetConnection : TSocketStream;
 
 var
   NewSocket : longint;
-  l : integer;
 
 begin
   Result:=Nil;
-  L:=SizeOf(FAddr);
   NewSocket:=Accept;
   if (NewSocket<0) then
     Raise ESocketError.Create(seAcceptFailed,[Socket,SocketError]);
@@ -817,6 +873,22 @@ begin
   (Result as TUnixSocket).FFileName:=FFileName;
 end;
 
+Function TUnixServer.GetConnection : TSocketStream;
+
+var
+  NewSocket : longint;
+
+begin
+  Result:=Nil;
+  NewSocket:=Accept;
+  if (NewSocket<0) then
+    Raise ESocketError.Create(seAcceptFailed,[Socket,SocketError]);
+  If FAccepting and DoConnectQuery(NewSocket) Then
+    Result:=SockToStream(NewSocket)
+  else
+    CloseSocket(NewSocket);
+end;
+
 {$endif}
 
 { ---------------------------------------------------------------------