diff options
Diffstat (limited to 'packages/fcl-net/src/ssockets.pp')
| -rw-r--r-- | packages/fcl-net/src/ssockets.pp | 89 |
1 files changed, 69 insertions, 20 deletions
diff --git a/packages/fcl-net/src/ssockets.pp b/packages/fcl-net/src/ssockets.pp index f64e39cb37..8908a43062 100644 --- a/packages/fcl-net/src/ssockets.pp +++ b/packages/fcl-net/src/ssockets.pp @@ -18,7 +18,8 @@ unit ssockets; interface uses - SysUtils, Classes, ctypes, sockets; +// This must be here, to prevent it from overriding the sockets definitions... :/ + SysUtils, Classes, ctypes, sockets; type @@ -111,6 +112,7 @@ type TSocketServer = Class(TObject) Private + FIdleTimeOut: Cardinal; FOnAcceptError: TOnAcceptError; FOnIdle : TNotifyEvent; FNonBlocking : Boolean; @@ -139,6 +141,7 @@ type Function SockToStream (ASocket : Longint) : TSocketStream;Virtual;Abstract; Procedure Close; Virtual; Procedure Abort; + Function RunIdleLoop : Boolean; function GetConnection: TSocketStream; virtual; abstract; Function HandleAcceptError(E : ESocketError) : TAcceptErrorAction; Property Handler : TSocketHandler Read FHandler; @@ -166,6 +169,9 @@ type Property ReuseAddress : Boolean Read GetReuseAddress Write SetReuseAddress; // -1 means no linger. Any value >=0 sets linger on. Property Linger: Integer Read GetLinger Write Setlinger; + // Accept Timeout in milliseconds. + // If Different from 0, then there will be an idle loop before accepting new connections, Calling OnIdle if no new connection appeared in the specified timeout. + Property AcceptIdleTimeOut : Cardinal Read FIdleTimeOut Write FIdleTimeout; end; { TInetServer } @@ -239,7 +245,10 @@ Implementation uses {$ifdef unix} - BaseUnix, Unix, + BaseUnix,Unix, +{$endif} +{$ifdef windows} + winsock2, windows, {$endif} resolve; @@ -296,7 +305,8 @@ end; function TSocketHandler.Shutdown(BiDirectional: Boolean): boolean; begin - CheckSocket + CheckSocket ; + Result:=False; end; function TSocketHandler.Recv(Const Buffer; Count: Integer): Integer; @@ -445,20 +455,20 @@ begin Result:=FHandler.Send(Buffer,Count); end; -function TSocketStream.GetLocalAddress: TSockAddr; +function TSocketStream.GetLocalAddress: sockets.TSockAddr; var len: LongInt; begin - len := SizeOf(TSockAddr); + len := SizeOf(sockets.TSockAddr); if fpGetSockName(Handle, @Result, @len) <> 0 then FillChar(Result, SizeOf(Result), 0); end; -function TSocketStream.GetRemoteAddress: TSockAddr; +function TSocketStream.GetRemoteAddress: sockets.TSockAddr; var len: LongInt; begin - len := SizeOf(TSockAddr); + len := SizeOf(sockets.TSockAddr); if fpGetPeerName(Handle, @Result, @len) <> 0 then FillChar(Result, SizeOf(Result), 0); end; @@ -499,7 +509,7 @@ end; TSocketServer ---------------------------------------------------------------------} -Constructor TSocketServer.Create(ASocket : Longint; AHandler : TSocketHandler); +constructor TSocketServer.Create(ASocket: Longint; AHandler: TSocketHandler); begin FSocket:=ASocket; @@ -510,7 +520,7 @@ begin FHandler:=AHandler; end; -Destructor TSocketServer.Destroy; +destructor TSocketServer.Destroy; begin Close; @@ -518,7 +528,7 @@ begin Inherited; end; -Procedure TSocketServer.Close; +procedure TSocketServer.Close; begin If FSocket<>-1 Then @@ -542,7 +552,40 @@ begin {$endif} end; -Procedure TSocketServer.Listen; +function TSocketServer.RunIdleLoop: Boolean; + +// Run Accept idle loop. Return True if there is a new connection waiting +{$if defined(unix) or defined(windows)} +var + FDS: TFDSet; + TimeV: TTimeVal; +{$endif} +begin + Repeat + Result:=False; +{$if defined(unix) or defined(windows)} + TimeV.tv_usec := (AcceptIdleTimeout mod 1000) * 1000; + TimeV.tv_sec := AcceptIdleTimeout div 1000; +{$endif} +{$ifdef unix} + FDS := Default(TFDSet); + fpFD_Zero(FDS); + fpFD_Set(FSocket, FDS); + Result := fpSelect(FSocket + 1, @FDS, @FDS, @FDS, @TimeV) > 0; +{$else} +{$ifdef windows} + FDS := Default(TFDSet); + FD_Zero(FDS); + FD_Set(FSocket, FDS); + Result := Select(FSocket + 1, @FDS, @FDS, @FDS, @TimeV) > 0; +{$endif} +{$endif} + If not Result then + DoOnIdle; + Until Result or (Not FAccepting); +end; + +procedure TSocketServer.Listen; begin If Not FBound then @@ -551,7 +594,7 @@ begin Raise ESocketError.Create(seListenFailed,[FSocket,SocketError]); end; -function TSocketServer.GetSockopt(ALevel, AOptName: cint; Var optval; +function TSocketServer.GetSockopt(ALevel, AOptName: cint; var optval; var optlen: tsocklen): Boolean; begin Result:=fpGetSockOpt(FSocket,ALevel,AOptName,@optval,@optlen)<>-1; @@ -589,7 +632,7 @@ begin FOnAcceptError(Self,FSocket,E,Result); end; -Procedure TSocketServer.StartAccepting; +procedure TSocketServer.StartAccepting; Var NoConnections : Integer; @@ -602,7 +645,10 @@ begin Repeat Repeat Try - Stream:=GetConnection; + If (AcceptIdleTimeOut=0) or RunIdleLoop then + Stream:=GetConnection + else + Stream:=Nil; if Assigned(Stream) then begin Inc (NoConnections); @@ -633,7 +679,7 @@ begin Abort; end; -Procedure TSocketServer.DoOnIdle; +procedure TSocketServer.DoOnIdle; begin If Assigned(FOnIdle) then @@ -689,14 +735,14 @@ begin Result:=l.l_linger; end; -Procedure TSocketServer.DoConnect(ASocket : TSocketStream); +procedure TSocketServer.DoConnect(ASocket: TSocketStream); begin If Assigned(FOnConnect) Then FOnConnect(Self,ASocket); end; -Function TSocketServer.DoConnectQuery(ASocket : Longint) : Boolean; +function TSocketServer.DoConnectQuery(ASocket: longint): Boolean; begin Result:=True; @@ -704,7 +750,7 @@ begin FOnConnectQuery(Self,ASocket,Result); end; -Procedure TSocketServer.SetNonBlocking; +procedure TSocketServer.SetNonBlocking; begin {$ifdef Unix} @@ -812,8 +858,11 @@ begin {$endif} if (Result<0) or Not (FAccepting and FHandler.Accept) then begin - CloseSocket(Result); - Raise ESocketError.Create(seAcceptFailed,[Socket,SocketError]) + If (Result>=0) then + CloseSocket(Result); + // Do not raise an error if we've stopped accepting. + if FAccepting then + Raise ESocketError.Create(seAcceptFailed,[Socket,SocketError]) end; end; |