paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-16 10:39:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

Fixed work in ThreadMode := wtmNone mode.

Browse Source
This commit is contained in:
Yuri Serebrennikov 2024-08-10 01:30:55 +03:00 committed by Yuri Silver
parent 0366df9fbd
commit 73ee25071d
3 changed files with 10 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
packages/fcl-web/src/websocket/fpcustwsserver.pp
View File

@ -444,14 +444,16 @@ Var
L : TList; L : TList;
aContinue : Boolean; aContinue : Boolean;
I : Integer; I : Integer;
begin begin
aContinue:=True; aContinue:=True;
L:=Connections.LockList; L:=Connections.LockList;
try try
For I:=L.Count-1 downto 0 do For I:=L.Count-1 downto 0 do
if aContinue then begin
aIterator(TWSServerConnection(L[i]),aContinue); aIterator(TWSServerConnection(L[i]), aContinue);
if not aContinue then
RemoveConnection(TWSServerConnection(L[i]), True);
end;
finally finally
Connections.UnlockList; Connections.UnlockList;
end; end;
@ -633,13 +635,12 @@ end;
procedure TWSServerConnectionHandler.DoCheckConnectionRequests(aConnection: TWSServerConnection; var aContinue: boolean); procedure TWSServerConnectionHandler.DoCheckConnectionRequests(aConnection: TWSServerConnection; var aContinue: boolean);
begin begin
aConnection.CheckIncoming(WaitTime,True); aContinue := aConnection.CheckIncoming(WaitTime, True) <> irClose;
aContinue:=True;
end; end;
procedure TWSServerConnectionHandler.RemoveConnection(aConnection: TWSServerConnection); procedure TWSServerConnectionHandler.RemoveConnection(aConnection: TWSServerConnection);
begin begin
FServer.RemoveConnection(aConnection,True); FServer.RemoveConnection(aConnection, True);
end; end;
procedure TWSServerConnectionHandler.HandleError(aConnection : TWSServerConnection; E: Exception); procedure TWSServerConnectionHandler.HandleError(aConnection : TWSServerConnection; E: Exception);
@ -700,7 +701,6 @@ begin
end; end;
procedure TWSThreadedConnectionHandler.TWSConnectionThread.Execute; procedure TWSThreadedConnectionHandler.TWSConnectionThread.Execute;
begin begin
try try
// Always handle first request // Always handle first request
@ -711,7 +711,7 @@ begin
Terminate; Terminate;
end; end;
While not Terminated do While not Terminated do
if Connection.CheckIncoming(10)=irClose then if Connection.CheckIncoming(WaitTime) = irClose then
begin begin
// answer for client about close connection // answer for client about close connection
if not (Connection.CloseState = csClosed) then if not (Connection.CloseState = csClosed) then
@ -827,15 +827,13 @@ begin
end; end;
procedure TWSPooledConnectionHandler.ConnectionDone(Sender: TObject); procedure TWSPooledConnectionHandler.ConnectionDone(Sender: TObject);
var var
aTask : THandleRequestTask absolute Sender; aTask : THandleRequestTask absolute Sender;
aConn : TWSServerConnection; aConn : TWSServerConnection;
begin begin
aConn:=aTask.Connection; aConn:=aTask.Connection;
FBusy.Remove(aConn); FBusy.Remove(aConn);
if aConn.CheckIncoming(10)=irClose then if aConn.CheckIncoming(WaitTime) = irClose then
RemoveConnection(aConn); RemoveConnection(aConn);
end; end;

5
packages/fcl-web/src/websocket/fpwebsocket.pp
View File

@ -354,7 +354,7 @@ type
// read & process incoming message. Return nil if connection was close. // read & process incoming message. Return nil if connection was close.
function ReadMessage: Boolean; function ReadMessage: Boolean;
// Disconnect // Disconnect
Procedure Disconnect; Procedure Disconnect; inline;
// Descendents can override this to provide custom frames // Descendents can override this to provide custom frames
Function FrameClass : TWSFrameClass; virtual; Function FrameClass : TWSFrameClass; virtual;
// Send raw frame. No checking is done ! // Send raw frame. No checking is done !
@ -1602,8 +1602,6 @@ end;
procedure TWSConnection.Disconnect; procedure TWSConnection.Disconnect;
begin begin
DoDisconnect; DoDisconnect;
if Assigned(FOnDisconnect) then
FOnDisconnect(Self);
end; end;
procedure TWSConnection.Close(aData: TBytes); procedure TWSConnection.Close(aData: TBytes);
@ -1664,7 +1662,6 @@ begin
end; end;
function TWSConnection.CheckIncoming(aTimeout: Integer; DoRead: Boolean = True): TIncomingResult; function TWSConnection.CheckIncoming(aTimeout: Integer; DoRead: Boolean = True): TIncomingResult;
begin begin
if not Transport.CanRead(aTimeOut) then if not Transport.CanRead(aTimeOut) then
Result:=irNone Result:=irNone

3
packages/fcl-web/src/websocket/fpwebsocketserver.pp
View File

@ -150,7 +150,6 @@ begin
end; end;
procedure TAcceptThread.Execute; procedure TAcceptThread.Execute;
begin begin
FServer.StartAccepting; FServer.StartAccepting;
end; end;
@ -357,14 +356,12 @@ begin
end; end;
procedure TWebSocketServer.StartAccepting; procedure TWebSocketServer.StartAccepting;
begin begin
FActive:=True; FActive:=True;
FServer.StartAccepting; FServer.StartAccepting;
end; end;
procedure TWebSocketServer.StartServer; procedure TWebSocketServer.StartServer;
begin begin
StartConnectionHandler; StartConnectionHandler;
CreateServerSocket; CreateServerSocket;