* Connection list, allow to set descendent for connections and disconnect/connectiondropped events

packages/fcl-net/examples/isockcli.pp

@@ -33,13 +33,18 @@ var
   i : longint;
 
 begin
+  Writeln('Using -n command-line will not send the QUIT command.');
   S:='This is a textstring sent by the client'#10;
   With TInetSocket.Create(TheHost,ThePort,StrToIntDef(ParamStr(1),0)) do
     begin
     For I:=1 to 10 do
       Write(S[1],Length(S));
-    S:='QUIT'#10;
-    Write(S[1],Length(S));
+    if ParamStr(1)<>'-n' then
+      begin
+      Writeln('Sending QUIT command');
+      S:='QUIT'#10;
+      Write(S[1],Length(S));
+      end;
     Free;
     end;
 end.

packages/fcl-net/examples/isocksvr.pp

@@ -19,13 +19,23 @@ Program server;
 }
 
 {$mode objfpc}{$H+}
-uses ssockets;
+uses 
+  {$IFDEF UNIX}cthreads,{$ENDIF} 
+  classes, sockets, ssockets;
 
 
 const
   ThePort=4100;
 
 Type
+  { TAcceptThread }
+
+  TAcceptThread = Class(TThread)
+    FSocket : TInetServer;
+    Constructor Create(aSocket : TInetServer);
+    Procedure Execute; override;
+  end;
+
   TINetServerApp = Class(TObject)
   Private
     FServer : TInetServer;
@@ -33,14 +43,33 @@ Type
     Constructor Create(Port : longint);
     Destructor Destroy;override;
     Procedure OnConnect (Sender : TObject; Data : TSocketStream);
+    Procedure OnDisConnect (Sender : TObject; Data : TSocketStream);
     Procedure Run;
   end;
 
+
+{ TAcceptThread }
+
+constructor TAcceptThread.Create(aSocket: TInetServer);
+begin
+  FSocket:=aSocket;
+  FreeOnTerminate:=True;
+  Inherited Create(False);
+end;
+
+procedure TAcceptThread.Execute;
+begin
+  FSocket.StartAccepting;
+end;
+
+{ TInetServerApp }
+
 Constructor TInetServerApp.Create(Port : longint);
 
 begin
   FServer:=TINetServer.Create(Port);
   FServer.OnConnect:=@OnConnect;
+  FServer.OnDisConnect:=@OnDisConnect;
 end;
 
 Destructor TInetServerApp.Destroy;
@@ -49,6 +78,32 @@ begin
   FServer.Free;
 end;
 
+
+Function SocketAddrToString(ASocketAddr: TSockAddr): AnsiString;
+
+Var
+  S : ShortString;
+
+begin
+  Result:='';
+  if ASocketAddr.sa_family = AF_INET then
+    begin
+    S := NetAddrToStr(ASocketAddr.sin_addr);
+    Result:=S;
+    end;
+end;
+
+Procedure TInetServerApp.OnDisConnect (Sender : TObject; Data : TSocketStream);
+
+
+var
+  PeerHost : String;
+
+begin
+  PeerHost:=SocketAddrToString(Data.RemoteAddress);
+  Writeln('Disconnecting from ',PeerHost);
+end;
+
 Procedure TInetServerApp.OnConnect (Sender : TObject; Data : TSocketStream);
 
 
@@ -56,19 +111,21 @@ Var Buf : ShortString;
     Count : longint;
 
 begin
+  Writeln('Connection from ',SocketAddrToString(Data.RemoteAddress));
   Repeat
     Count:=Data.Read(Buf[1],255);
     SetLength(Buf,Count);
     Write('Server got : ',Buf);
   Until (Count=0) or (Pos('QUIT',Buf)<>0);
+  if Pos('QUIT',Buf)<>0 then
+    FServer.StopAccepting;
   Data.Free;
-  FServer.StopAccepting;
 end;
 
 Procedure TInetServerApp.Run;
 
 begin
-  FServer.StartAccepting;
+  TAcceptThread.Create(FServer).WaitFor;
 end;
 
 Var

packages/fcl-net/src/ssockets.pp

@@ -45,6 +45,15 @@ type
   TAcceptErrorAction = (aeaRaise,aeaIgnore,aeaStop);
   TSocketStream = Class;
   TSocketServer = Class;
+  TInetSocket = Class;
+{$IFDEF UNIX}
+  TUnixSocket = class;
+  TUnixSocketClass = Class of TUnixSocket;
+{$ENDIF}
+  TSocketStreamClass = Class of TSocketStream;
+  TInetSocketClass = Class of TInetSocket;
+
+
 
   // Handles all OS calls
 
@@ -85,6 +94,9 @@ type
 
   TSocketStream = class(THandleStream)
   Private
+    FClosed: Boolean;
+    FOnClose: TNotifyEvent;
+    FPeerClosed: Boolean;
     FReadFlags: Integer;
     FSocketInitialized : Boolean;
     FSocketOptions : TSocketOptions;
@@ -100,10 +112,12 @@ type
     function GetRemoteAddress: TSockAddr;
     procedure SetIOTimeout(AValue: Integer);
   Protected
+    Procedure DoOnClose; virtual;
   Public
     Constructor Create (AHandle : Longint; AHandler : TSocketHandler = Nil);virtual;
     destructor Destroy; override;
     Class Function Select(Var aRead,aWrite,aExceptions : TSocketStreamArray; aTimeOut: Integer): Boolean; virtual;
+    Procedure Close;
     function Seek(Offset: Longint; Origin: Word): Longint; override;
     function Select(aCheck : TSocketStates; TimeOut : Integer): TSocketStates;
     Function CanRead(TimeOut : Integer): Boolean;
@@ -118,21 +132,33 @@ type
     Property WriteFlags : Integer Read FWriteFlags Write FWriteFlags;
     Property IOTimeout : Integer read FIOTimeout Write SetIOTimeout;
     Property ConnectTimeout : Integer read FConnectTimeout Write SetConnectTimeout;
+    Property OnClose : TNotifyEvent Read FOnClose Write FOnClose;
     Property Handler : TSocketHandler Read FHandler;
+    // We called close
+    Property Closed : Boolean read FClosed;
+    // Peer closed detected when reading.
+    Property PeerClosed : Boolean Read FPeerClosed;
   end;
 
-  TConnectEvent = Procedure (Sender : TObject; Data : TSocketStream) Of Object;
+  TSocketClientEvent = Procedure (Sender : TObject; Data : TSocketStream) Of Object;
+  TConnectEvent = TSocketClientEvent;
+  TDisconnectEvent = TSocketClientEvent;
+  TConnectionDroppedEvent = TSocketClientEvent;
   TConnectQuery = Procedure (Sender : TObject; ASocket : Longint; Var Allow : Boolean) of Object;
   TOnAcceptError = Procedure (Sender : TObject; ASocket : Longint; E : Exception; Var ErrorAction : TAcceptErrorAction) of Object;
   TGetClientSocketHandlerEvent = Procedure (Sender : TObject; Out AHandler : TSocketHandler) of object;
+  TForeachHandler = Procedure (Sender : TObject; aClient : TSocketStream; var aContinue : Boolean) of object;
 
   { TSocketServer }
 
   TSocketServer = Class(TObject)
   Private
     FIdleTimeOut: Cardinal;
+    FMaxSimultaneousConnections: longint;
     FOnAcceptError: TOnAcceptError;
+    FOnConnectionDropped: TConnectionDroppedEvent;
     FOnCreateClientSocketHandler: TGetClientSocketHandlerEvent;
+    FOnDisconnect: TDisconnectEvent;
     FOnIdle : TNotifyEvent;
     FNonBlocking : Boolean;
     FSocket : longint;
@@ -143,7 +169,9 @@ type
     FOnConnect : TConnectEvent;
     FOnConnectQuery : TConnectQuery;
     FHandler : TSocketHandler;
+    FConnections : TThreadList;
     Procedure DoOnIdle;
+    function GetConnectionCount: Integer;
     Function GetReuseAddress: Boolean;
     Function GetKeepAlive : Boolean;
     Function GetLinger : Integer;
@@ -153,6 +181,9 @@ type
   Protected
     FSockType : Longint;
     FBound : Boolean;
+    Procedure SocketClosed(aSocket: TSocketStream);
+    Procedure DoConnectionDropped(aSocket : TSocketStream); virtual;
+    Procedure DoDisconnect(aSocket : TSocketStream); virtual;
     Procedure DoConnect(ASocket : TSocketStream); Virtual;
     Function  DoConnectQuery(ASocket : longint): Boolean ;Virtual;
     Procedure Bind; Virtual; Abstract;
@@ -160,6 +191,8 @@ type
     Function  SockToStream (ASocket : Longint) : TSocketStream;Virtual;Abstract;
     Procedure Close; Virtual;
     Procedure Abort;
+    Procedure RemoveSelfFromConnections; virtual;
+
     Function RunIdleLoop : Boolean;
     function GetConnection: TSocketStream; virtual; abstract;
     Function HandleAcceptError(E : ESocketError) : TAcceptErrorAction;
@@ -174,11 +207,16 @@ type
     Procedure StartAccepting;
     Procedure StopAccepting(DoAbort : Boolean = False);
     Procedure SetNonBlocking;
+    Procedure Foreach(aHandler : TForeachHandler);
     Property Bound : Boolean Read FBound;
     // Maximium number of connections in total. *Not* the simultaneous connection count. -1 keeps accepting.
     Property MaxConnections : longint Read FMaxConnections Write FMaxConnections;
+    Property MaxSimultaneousConnections : longint Read FMaxSimultaneousConnections Write FMaxSimultaneousConnections;
+
     Property QueueSize : Longint Read FQueueSize Write FQueueSize default 5;
     Property OnConnect : TConnectEvent Read FOnConnect Write FOnConnect;
+    Property OnDisconnect : TDisconnectEvent Read FOnDisconnect Write FOnDisconnect;
+    Property OnConnectionDropped : TConnectionDroppedEvent Read FOnConnectionDropped Write FOnConnectionDropped;
     Property OnConnectQuery : TConnectQuery Read FOnConnectQuery Write FOnConnectQuery;
     Property OnAcceptError : TOnAcceptError Read FOnAcceptError Write FOnAcceptError;
     Property OnIdle : TNotifyEvent Read FOnIdle Write FOnIdle;
@@ -193,19 +231,23 @@ type
     // 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;
     Property OnCreateClientSocketHandler : TGetClientSocketHandlerEvent Read FOnCreateClientSocketHandler Write FOnCreateClientSocketHandler;
+    Property ConnectionCount : Integer Read GetConnectionCount;
   end;
 
   { TInetServer }
 
   TInetServer = Class(TSocketServer)
   private
-  Protected
     FAddr : TINetSockAddr;
     FPort : Word;
     FHost: string;
+  Protected
     Function GetConnection: TSocketStream; override;
     Function SockToStream (ASocket : Longint) : TSocketStream;Override;
     Function Accept : Longint;override;
+    Property Addr : TINetSockAddr Read FAddr;
+  Public
+    DefaultInetSocketClass : TInetSocketClass;
   Public
     Procedure Bind; Override;
     Constructor Create(APort: Word);
@@ -228,6 +270,8 @@ type
     function GetConnection: TSocketStream; override;
     Function SockToStream (ASocket : Longint) : TSocketStream;Override;
     Procedure Close; override;
+  Public
+    DefaultUnixSocketClass : TUnixSocketClass;
   Public
     Constructor Create(AFileName : String; AHandler : TSocketHandler = Nil);
     Property FileName : String Read FFileName;
@@ -239,10 +283,20 @@ type
   TBlockingModes = Set of TBlockingMode;
   TCheckTimeoutResult = (ctrTimeout,ctrError,ctrOK);
 
+  { TServerSocketStream }
+
+  TServerSocketStream = class(TSocketStream)
+  Protected
+    FServer : TSocketServer;
+  Protected
+    Procedure DoOnClose; override;
+    Property Server : TSocketServer Read FServer;
+  end;
+
 {$if defined(unix) or defined(windows)}
 {$DEFINE HAVENONBLOCKING}
 {$endif}
-  TInetSocket = Class(TSocketStream)
+  TInetSocket = Class(TServerSocketStream)
   Private
     FHost : String;
     FPort : Word;
@@ -261,7 +315,7 @@ type
 
 {$ifdef Unix}
 
-  TUnixSocket = Class(TSocketStream)
+  TUnixSocket = Class(TServerSocketStream)
   Private
     FFileName : String;
   Protected
@@ -306,6 +360,15 @@ resourcestring
   strErrNoStream = 'Socket stream not assigned';
   strSocketConnectTimeOut = 'Connection to %s timed out.';
 
+{ TServerSocketStream }
+
+procedure TServerSocketStream.DoOnClose;
+begin
+  if Assigned(FServer) then
+    FServer.SocketClosed(Self);
+  inherited DoOnClose;
+end;
+
 { TSocketHandler }
 
 Procedure TSocketHandler.SetSocket(const AStream: TSocketStream);
@@ -515,7 +578,7 @@ end;
 { ---------------------------------------------------------------------
     TSocketStream
   ---------------------------------------------------------------------}
-Constructor TSocketStream.Create (AHandle : Longint; AHandler : TSocketHandler = Nil);
+constructor TSocketStream.Create(AHandle: Longint; AHandler: TSocketHandler);
 
 begin
   Inherited Create(AHandle);
@@ -529,14 +592,12 @@ end;
 
 destructor TSocketStream.Destroy;
 begin
-  if FSocketInitialized then
-    FHandler.Close; // Ignore the result
-  FreeAndNil(FHandler);  
-  CloseSocket(Handle);
+  Close;
   inherited Destroy;
 end;
 
-class function TSocketStream.Select(var aRead, aWrite, aExceptions: TSocketStreamArray; ATimeout : Integer): Boolean;
+class function TSocketStream.Select(var aRead, aWrite,
+  aExceptions: TSocketStreamArray; aTimeOut: Integer): Boolean;
 
 {$if defined(unix) or defined(windows)}
 var
@@ -626,6 +687,16 @@ begin
 {$ENDIF}  
 end;
 
+procedure TSocketStream.Close;
+begin
+  DoOnClose;
+  if FSocketInitialized then
+    FHandler.Close; // Ignore the result
+  FreeAndNil(FHandler);
+  CloseSocket(Handle);
+  FClosed:=True;
+end;
+
 procedure TSocketStream.GetSockOptions;
 {$ifdef windows}
 var
@@ -661,7 +732,7 @@ begin
   Result:=FHandler.LastError;
 end;
 
-Procedure TSocketStream.SetSocketOptions(Value : TSocketOptions);
+procedure TSocketStream.SetSocketOptions(Value: TSocketOptions);
 
 begin
   FSocketOptions:=Value;
@@ -678,24 +749,26 @@ begin
   Result:=FHandler.Select(aCheck,TimeOut);
 end;
 
-Function TSocketStream.CanRead (TimeOut : Integer) : Boolean;
+function TSocketStream.CanRead(TimeOut: Integer): Boolean;
 begin
   Result:=FHandler.CanRead(TimeOut);
 end;
 
-Function TSocketStream.Read (Var Buffer; Count : Longint) : longint;
+function TSocketStream.Read(var Buffer; Count: Longint): longint;
 
 begin
   Result:=FHandler.Recv(Buffer,Count);
+  if (Result=0) then
+    FPeerClosed:=True;
 end;
 
-Function TSocketStream.Write (Const Buffer; Count : Longint) :Longint;
+function TSocketStream.Write(const Buffer; Count: Longint): Longint;
 
 begin
   Result:=FHandler.Send(Buffer,Count);
 end;
 
-function TSocketStream.GetLocalAddress: sockets.TSockAddr;
+function TSocketStream.GetLocalAddress: TSockAddr;
 var
   len: LongInt;
 begin
@@ -704,7 +777,7 @@ begin
     FillChar(Result, SizeOf(Result), 0);
 end;
 
-function TSocketStream.GetRemoteAddress: sockets.TSockAddr;
+function TSocketStream.GetRemoteAddress: TSockAddr;
 var
   len: LongInt;
 begin
@@ -746,6 +819,12 @@ begin
     Raise ESocketError.Create(seIOTimeout,[AValue]);
 end;
 
+procedure TSocketStream.DoOnClose;
+begin
+  If Assigned(FOnClose) then
+    FOnClose(Self);
+end;
+
 { ---------------------------------------------------------------------
     TSocketServer
   ---------------------------------------------------------------------}
@@ -759,11 +838,14 @@ begin
   if (AHandler=Nil) then
     AHandler:=TSocketHandler.Create;
   FHandler:=AHandler;
+  FConnections:=TThreadList.Create;
 end;
 
 destructor TSocketServer.Destroy;
 
 begin
+  RemoveSelfFromConnections;
+  FreeAndNil(FConnections);
   Close;
   FreeAndNil(FHandler);
   Inherited;
@@ -793,6 +875,22 @@ begin
 {$endif}
 end;
 
+procedure TSocketServer.RemoveSelfFromConnections;
+
+Var
+  L : TList;
+  P: Pointer;
+
+begin
+  L:=FConnections.LockList;
+  try
+    for P in L do
+      TServerSocketStream(P).FServer:=Nil;
+  finally
+    FConnections.UnlockList;
+  end;
+end;
+
 function TSocketServer.RunIdleLoop: Boolean;
 
 // Run Accept idle loop. Return True if there is a new connection waiting
@@ -903,10 +1001,22 @@ begin
         else
           Stream:=Nil;
         if Assigned(Stream) then
-          begin
-          Inc(NoConnections);
-          DoConnect(Stream);
-          end;
+          if (MaxSimultaneousConnections>0) and (ConnectionCount>=MaxSimultaneousConnections) then
+            begin
+            Stream.Close;
+            DoConnectionDropped(Stream);
+            FreeAndNil(Stream);
+            end
+          else
+            begin
+            if Stream is TServerSocketStream then
+              begin
+              FConnections.Add(Stream);
+              TServerSocketStream(Stream).FServer:=Self;
+              end;
+            Inc(NoConnections);
+            DoConnect(Stream);
+            end;
       except
         On E : ESocketError do
           begin
@@ -939,6 +1049,20 @@ begin
     FOnIdle(Self);
 end;
 
+function TSocketServer.GetConnectionCount: Integer;
+
+Var
+  L : TList;
+
+begin
+  L:=FConnections.LockList;
+  try
+    Result:=L.Count;
+  finally
+    FConnections.UnlockList;
+  end;
+end;
+
 function TSocketServer.GetReuseAddress: Boolean;
 Var
   L : cint;
@@ -1012,6 +1136,28 @@ begin
   FNonBlocking:=True;
 end;
 
+procedure TSocketServer.Foreach(aHandler: TForeachHandler);
+
+Var
+  L : TList;
+  P : Pointer;
+  aContinue : Boolean;
+
+begin
+  L:=FConnections.LockList;
+  try
+    aContinue:=True;
+    For P in L do
+      begin
+      aHandler(Self,TSocketStream(P),aContinue);
+      if not aContinue then
+        break;
+      end;
+  finally
+    FConnections.UnlockList;
+  end;
+end;
+
 procedure TSocketServer.SetLinger(ALinger: Integer);
 Var
   L : linger;
@@ -1025,6 +1171,24 @@ begin
     Raise ESocketError.CreateFmt('Failed to set linger: %d',[socketerror]);
 end;
 
+procedure TSocketServer.SocketClosed(aSocket: TSocketStream);
+begin
+  FConnections.Remove(aSocket);
+  DoDisConnect(aSocket);
+end;
+
+procedure TSocketServer.DoConnectionDropped(aSocket: TSocketStream);
+begin
+  If Assigned(FOnConnectionDropped) then
+    FOnConnectionDropped(Self,aSocket);
+end;
+
+procedure TSocketServer.DoDisconnect(aSocket: TSocketStream);
+begin
+  If Assigned(FOnDisconnect) then
+    FOnDisconnect(Self,aSocket);
+end;
+
 procedure TSocketServer.SetReuseAddress(AValue: Boolean);
 Var
   L : cint;
@@ -1086,6 +1250,7 @@ function TInetServer.SockToStream(ASocket: Longint): TSocketStream;
 Var
   H : TSocketHandler;
   A : Boolean;
+  aClass : TInetSocketClass;
 
   procedure ShutDownH;
   begin
@@ -1093,9 +1258,13 @@ Var
     FreeAndNil(Result);
   end;
 
+
 begin
   H:=GetClientSocketHandler(aSocket);
-  Result:=TInetSocket.Create(ASocket,H);
+  aClass:=DefaultInetSocketClass;
+  if aClass=Nil then
+      aClass:=TInetSocket;
+  Result:=aClass.Create(ASocket,H);
   (Result as TInetSocket).FHost:='';
   (Result as TInetSocket).FPort:=FPort;
 
@@ -1190,8 +1359,14 @@ end;
 
 Function  TUnixServer.SockToStream (ASocket : Longint) : TSocketStream;
 
+var
+  aClass : TUnixSocketClass;
+
 begin
-  Result:=TUnixSocket.Create(ASocket);
+  aClass:=DefaultUnixSocketClass;
+  if aClass=Nil then
+    aClass:=TUnixSocket;
+  Result:=aClass.Create(ASocket);
   (Result as TUnixSocket).FFileName:=FFileName;
 end;