On 12/26/22 8:48 AM, Michael Van Canneyt via fpc-pascal wrote:
I attached a console version. It uses threads. If this is useful at all please feel free to add it to the examples and modify it however you want.Please make a version of your program that does not use the LCL. Then I'll test that too.2 reasons for this request: - I don't have a working version of Lazarus with FPC trunk. - I want to exclude the problems of dealing with the main application message loop.
I found the problem. First was the problem of no data being read, which you fixed by changing the inheritance. But the second problem is that the OutgoingFrameMask value was not being used. In the rfc section 5.2 it states in the Mask bit explanation that all frames sent from a client must be masked. Unfortunately the echo server was not giving a close frame with a protocol error which would have been useful.
In the attached patch there are 3 hunks that include the OutgoingFrameMask with the payload. The rest of the patch is about handling a connection that encounters an error sending data. I added an exception and also a flag that ignores the exception and tries to close gracefully.
You can compile the console client I sent without applying the patch to see how it was failing before. There are default servers to choose from.
Maybe in the client, the constructor should pick a mask at random by default since all frames from the client are supposed to be masked anyway. Section 5.3 has some strong language about the random mask having a strong entropy source. It actually says each frame should have a new unique mask so I'm not sure the OutgoingFrameMask property really makes sense since the mask is given to the connection only once when the connection is created. I doubt most server implementations care about this.
Regards, Andrew
diff --git a/packages/fcl-web/src/websocket/fpwebsocket.pp b/packages/fcl-web/src/websocket/fpwebsocket.pp
index 8424f6c44f..3b6ecd24be 100644
--- a/packages/fcl-web/src/websocket/fpwebsocket.pp
+++ b/packages/fcl-web/src/websocket/fpwebsocket.pp
@@ -287,7 +287,8 @@ TWSMessage = record
woCloseExplicit, // SeDo Close explicitly, not implicitly.
woIndividualFrames, // Send frames one by one, do not concatenate.
woSkipUpgradeCheck, // Skip handshake "Upgrade:" HTTP header cheack.
- woSkipVersionCheck // Skip handshake "Sec-WebSocket-Version' HTTP header check.
+ woSkipVersionCheck, // Skip handshake "Sec-WebSocket-Version' HTTP header check.
+ woSendErrClosesConn // Don't raise an exception when writing to a broken connection
);
TWSOptions = set of TWSOption;
@@ -482,6 +483,7 @@ TWSServerTransport = class(TWSTransport)
SErrServerActive = 'Operation cannot be performed while the websocket connection is active';
SErrInvalidSizeFlag = 'Invalid size flag: %d';
SErrInvalidFrameType = 'Invalid frame type flag: %d';
+ SErrWriteReturnedError = 'Write operation returned error: (%d) %s';
function DecodeBytesBase64(const s: string; Strict: boolean = false) : TBytes;
function EncodeBytesBase64(const aBytes : TBytes) : String;
@@ -1175,7 +1177,7 @@ procedure TWSConnection.Send(aFrameType : TFrameType; aData : TBytes = Nil);
begin
if not (aFrameType in [ftClose,ftPing,ftPong]) then
Raise EWebSocket.CreateFmt(SErrNotSimpleOperation,[Ord(aFrameType)]);
- aFrame:=FrameClass.Create(aFrameType,True,aData);
+ aFrame:=FrameClass.Create(aFrameType,True,aData, OutgoingFrameMask);
try
Send(aFrame);
finally
@@ -1532,7 +1534,7 @@ procedure TWSConnection.Send(const AMessage: UTF8string);
aFrame: TWSFrame;
begin
- aFrame:=FrameClass.Create(aMessage);
+ aFrame:=FrameClass.Create(aMessage, OutgoingFrameMask);
try
Send(aFrame);
finally
@@ -1544,7 +1546,7 @@ procedure TWSConnection.Send(const ABytes: TBytes);
var
aFrame: TWSFrame;
begin
- aFrame:=FrameClass.Create(ftBinary,True,ABytes);
+ aFrame:=FrameClass.Create(ftBinary,True,ABytes, OutgoingFrameMask);
try
Send(aFrame);
finally
@@ -1590,12 +1592,27 @@ procedure TWSConnection.Send(aFrame: TWSFrame);
Var
Data : TBytes;
+ Res: Integer;
+ ErrMsg: UTF8String;
begin
if FCloseState=csClosed then
Raise EWebSocket.Create(SErrCloseAlreadySent);
Data:=aFrame.AsBytes;
- Transport.WriteBytes(Data,Length(Data));
+ Res := Transport.WriteBytes(Data,Length(Data));
+ if Res < 0 then
+ begin
+ FCloseState:=csClosed;
+ ErrMsg := Format(SErrWriteReturnedError, [GetLastOSError, SysErrorMessage(GetLastOSError)]);
+ if woSendErrClosesConn in Options then
+ begin
+ SetLength(Data, 0);
+ Data.Append(TEncoding.UTF8.GetBytes(UnicodeString(ErrMsg)));
+ DispatchEvent(ftClose, nil, Data);
+ end
+ else
+ Raise EWebSocket.Create(ErrMsg);
+ end;
if (aFrame.FrameType=ftClose) then
begin
if FCloseState=csNone then
diff --git a/packages/fcl-web/src/websocket/fpwebsocketclient.pp b/packages/fcl-web/src/websocket/fpwebsocketclient.pp
index 18582636bb..ceabc9b793 100644
--- a/packages/fcl-web/src/websocket/fpwebsocketclient.pp
+++ b/packages/fcl-web/src/websocket/fpwebsocketclient.pp
@@ -475,7 +475,7 @@ procedure TCustomWebsocketClient.Disconnect(SendClose : boolean = true);
begin
if Not Active then
Exit;
- if SendClose then
+ if SendClose and (Connection.CloseState <> csClosed) then
Connection.Close('');
if Assigned(MessagePump) then
MessagePump.RemoveClient(Connection);
<<attachment: ws_echo_client.zip>>
_______________________________________________ fpc-pascal maillist - fpc-pascal@lists.freepascal.org https://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal
