From 41beb829a09337995b09d34f6b50162adc6a5967 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Mussche?= Date: Mon, 10 Feb 2014 11:30:56 +0100 Subject: [PATCH] unit test for plain http + websockets added improved (automatic) connection handling --- DUnit/UnitTestWebsockets.dpr | 4 +- DUnit/mtTestWebSockets.pas | 96 +++++++++++++++++++++++++++++++++-- IdHTTPWebsocketClient.pas | 78 +++++++++++++++++----------- IdIOHandlerWebsocket.pas | 12 +++++ IdServerWebsocketHandling.pas | 2 +- 5 files changed, 158 insertions(+), 34 deletions(-) diff --git a/DUnit/UnitTestWebsockets.dpr b/DUnit/UnitTestWebsockets.dpr index dec8666..c782959 100644 --- a/DUnit/UnitTestWebsockets.dpr +++ b/DUnit/UnitTestWebsockets.dpr @@ -11,9 +11,11 @@ program UnitTestWebsockets; } {$IFDEF CONSOLE_TESTRUNNER} -{$APPTYPE CONSOLE} + {$APPTYPE CONSOLE} {$ENDIF} +{$IFNDEF USE_JEDI_JCL} {$MESSAGE ERROR 'Must define "USE_JEDI_JCL" for location info of errors'} {$ENDIF} + {$R *.RES} uses diff --git a/DUnit/mtTestWebSockets.pas b/DUnit/mtTestWebSockets.pas index 57d5ebe..d315020 100644 --- a/DUnit/mtTestWebSockets.pas +++ b/DUnit/mtTestWebSockets.pas @@ -4,7 +4,8 @@ interface uses TestFramework, - IdHTTPWebsocketClient, IdServerWebsocketContext, IdWebsocketServer; + IdHTTPWebsocketClient, IdServerWebsocketContext, IdWebsocketServer, + IdContext, IdCustomHTTPServer; type TTextCallback = reference to procedure(aText: string); @@ -14,7 +15,11 @@ type class var IndyHTTPWebsocketServer1: TIdWebsocketServer; class var IndyHTTPWebsocketClient1: TIdHTTPWebsocketClient; protected + FLastWSMsg: string; FLastSocketIOMsg: string; + procedure HandleHTTPServerCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); + procedure WebsocketTextMessage(const aData: string); + procedure HandleWebsocketTextMessage(const AContext: TIdServerWSContext; const aText: string); public procedure SetUp; override; procedure TearDown; override; @@ -23,6 +28,9 @@ type procedure StartServer; + procedure TestPlainHttp; + procedure TestWebsocketMsg; + procedure TestSocketIOMsg; procedure TestSocketIOCallback; procedure TestSocketIOError; @@ -37,7 +45,7 @@ implementation uses Windows, Forms, DateUtils, SysUtils, Classes, - IdSocketIOHandling, superobject; + IdSocketIOHandling, superobject, IdIOHandlerWebsocket; function MaxWait(aProc: TBooleanFunction; aMaxWait_msec: Integer): Boolean; var @@ -89,11 +97,51 @@ begin IndyHTTPWebsocketServer1.Free; end; +procedure TTestWebSockets.HandleHTTPServerCommandGet(AContext: TIdContext; + ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); +begin + if ARequestInfo.Document = '/index.html' then + AResponseInfo.ContentText := 'dummy index.html'; +end; + procedure TTestWebSockets.StartServer; begin IndyHTTPWebsocketServer1.Active := True; end; +procedure TTestWebSockets.TestPlainHttp; +var + strm: TMemoryStream; + s: string; + client: TIdHTTPWebsocketClient; +begin + client := TIdHTTPWebsocketClient.Create(nil); + try + client.Host := 'localhost'; + client.Port := 8099; + client.SocketIOCompatible := False; //plain http now + IndyHTTPWebsocketServer1.OnCommandGet := HandleHTTPServerCommandGet; + IndyHTTPWebsocketServer1.OnCommandOther := HandleHTTPServerCommandGet; + + strm := TMemoryStream.Create; + try + client.Get('http://localhost:8099/index.html', strm); + with TStreamReader.Create(strm) do + begin + strm.Position := 0; + s := ReadToEnd; + Free; + end; + + CheckEquals('dummy index.html', s); + finally + strm.Free; + end; + finally + client.Free; + end; +end; + procedure TTestWebSockets.TestSocketIOCallback; var received: string; @@ -188,7 +236,9 @@ end; procedure TTestWebSockets.TestSocketIOMsg; begin //disconnect: mag geen AV's daarna geven! - IndyHTTPWebsocketClient1.Disconnect(False); + IndyHTTPWebsocketClient1.Disconnect(True); + IndyHTTPWebsocketClient1.ResetChannel; + IndyHTTPWebsocketClient1.SocketIOCompatible := True; IndyHTTPWebsocketClient1.Connect; IndyHTTPWebsocketClient1.UpgradeToWebsocket; @@ -230,5 +280,45 @@ begin IndyHTTPWebsocketClient1.SocketIO.Send('test message'); end; +procedure TTestWebSockets.TestWebsocketMsg; +var + client: TIdHTTPWebsocketClient; +begin + client := TIdHTTPWebsocketClient.Create(nil); + try + client.Host := 'localhost'; + client.Port := 8099; + client.SocketIOCompatible := False; + client.OnTextData := WebsocketTextMessage; + IndyHTTPWebsocketServer1.OnMessageText := HandleWebsocketTextMessage; + + //client.Connect; + client.UpgradeToWebsocket; + client.IOHandler.Write('websocket client to server'); + + MaxWait( + function: Boolean + begin + Result := FLastWSMsg <> ''; + end, 10 * 1000); + CheckEquals('websocket server to client', FLastWSMsg); + finally + client.Free; + end; +end; + +procedure TTestWebSockets.HandleWebsocketTextMessage( + const AContext: TIdServerWSContext; const aText: string); +begin + if aText = 'websocket client to server' then + AContext.IOHandler.Write('websocket server to client'); +end; + +procedure TTestWebSockets.WebsocketTextMessage(const aData: string); +begin + FLastWSMsg := aData; +end; + + end. diff --git a/IdHTTPWebsocketClient.pas b/IdHTTPWebsocketClient.pas index 512e9e6..725a8fb 100644 --- a/IdHTTPWebsocketClient.pas +++ b/IdHTTPWebsocketClient.pas @@ -22,8 +22,8 @@ uses IdSocketIOHandling; type - TDataBinEvent = procedure(const aData: TStream) of object; - TDataStringEvent = procedure(const aData: string) of object; + TWebsocketMsgBin = procedure(const aData: TStream) of object; + TWebsocketMsgText = procedure(const aData: string) of object; TIdHTTPWebsocketClient = class; TSocketIOMsg = procedure(const AClient: TIdHTTPWebsocketClient; const aText: string; aMsgNr: Integer) of object; @@ -35,12 +35,12 @@ type private FWSResourceName: string; FHash: TIdHashSHA1; - FOnData: TDataBinEvent; - FOnTextData: TDataStringEvent; + FOnData: TWebsocketMsgBin; + FOnTextData: TWebsocketMsgText; function GetIOHandlerWS: TIdIOHandlerWebsocket; procedure SetIOHandlerWS(const Value: TIdIOHandlerWebsocket); - procedure SetOnData(const Value: TDataBinEvent); - procedure SetOnTextData(const Value: TDataStringEvent); + procedure SetOnData(const Value: TWebsocketMsgBin); + procedure SetOnTextData(const Value: TWebsocketMsgText); protected FSocketIOCompatible: Boolean; FSocketIOHandshakeResponse: string; @@ -65,6 +65,7 @@ type function TryUpgradeToWebsocket: Boolean; procedure UpgradeToWebsocket; + function TryLock: Boolean; procedure Lock; procedure UnLock; @@ -75,8 +76,10 @@ type procedure Ping; property IOHandler: TIdIOHandlerWebsocket read GetIOHandlerWS write SetIOHandlerWS; - property OnBinData : TDataBinEvent read FOnData write SetOnData; - property OnTextData: TDataStringEvent read FOnTextData write SetOnTextData; + + //websockets + property OnBinData : TWebsocketMsgBin read FOnData write SetOnData; + property OnTextData: TWebsocketMsgText read FOnTextData write SetOnTextData; //https://github.com/LearnBoost/socket.io-spec property SocketIOCompatible: Boolean read FSocketIOCompatible write FSocketIOCompatible; @@ -428,8 +431,8 @@ begin Connect; Result := Connected; - if Result then - Result := TryUpgradeToWebsocket + //if Result then + // Result := TryUpgradeToWebsocket already done in connect except Result := False; end @@ -438,6 +441,11 @@ begin end; end; +function TIdHTTPWebsocketClient.TryLock: Boolean; +begin + Result := System.TMonitor.TryEnter(Self); +end; + function TIdHTTPWebsocketClient.TryUpgradeToWebsocket: Boolean; var sError: string; @@ -450,7 +458,7 @@ begin Result := (sError = ''); finally UnLock; - end; + end; end; procedure TIdHTTPWebsocketClient.UnLock; @@ -480,6 +488,8 @@ var sSocketioextended: string; begin Assert((IOHandler = nil) or not IOHandler.IsWebsocket); + //remove from thread during connection handling + TIdWebsocketMultiReadThread.Instance.RemoveClient(Self); strmResponse := TMemoryStream.Create; try @@ -721,6 +731,8 @@ begin if IOHandler <> nil then begin IOHandler.InputBuffer.Clear; + IOHandler.BusyUpgrading := False; + IOHandler.IsWebsocket := False; //close/disconnect internal socket //ws := IndyClient.IOHandler as TIdIOHandlerWebsocket; //ws.Close; done in disconnect below @@ -734,30 +746,30 @@ begin SetIOHandler(Value); end; -procedure TIdHTTPWebsocketClient.SetOnData(const Value: TDataBinEvent); +procedure TIdHTTPWebsocketClient.SetOnData(const Value: TWebsocketMsgBin); begin // if not Assigned(Value) and not Assigned(FOnTextData) then // TIdWebsocketMultiReadThread.Instance.RemoveClient(Self); FOnData := Value; - if Assigned(Value) and - (Self.IOHandler as TIdIOHandlerWebsocket).IsWebsocket - then - TIdWebsocketMultiReadThread.Instance.AddClient(Self); +// if Assigned(Value) and +// (Self.IOHandler as TIdIOHandlerWebsocket).IsWebsocket +// then +// TIdWebsocketMultiReadThread.Instance.AddClient(Self); end; -procedure TIdHTTPWebsocketClient.SetOnTextData(const Value: TDataStringEvent); +procedure TIdHTTPWebsocketClient.SetOnTextData(const Value: TWebsocketMsgText); begin // if not Assigned(Value) and not Assigned(FOnData) then // TIdWebsocketMultiReadThread.Instance.RemoveClient(Self); FOnTextData := Value; - if Assigned(Value) and - (Self.IOHandler as TIdIOHandlerWebsocket).IsWebsocket - then - TIdWebsocketMultiReadThread.Instance.AddClient(Self); +// if Assigned(Value) and +// (Self.IOHandler as TIdIOHandlerWebsocket).IsWebsocket +// then +// TIdWebsocketMultiReadThread.Instance.AddClient(Self); end; { TIdHTTPSocketIOClient } @@ -1139,7 +1151,9 @@ begin chn := TIdHTTPWebsocketClient(l.Items[i]); ws := chn.IOHandler as TIdIOHandlerWebsocket; //valid? - if (chn.Socket <> nil) and + if (chn.IOHandler <> nil) and + (chn.IOHandler.IsWebsocket) and + (chn.Socket <> nil) and (chn.Socket.Binding <> nil) and (chn.Socket.Binding.Handle > 0) and (chn.Socket.Binding.Handle <> INVALID_SOCKET) then @@ -1155,14 +1169,18 @@ begin end else if not chn.Connected then begin + if chn.TryLock then try - if ws <> nil then - ws.LastActivityTime := Now; - chn.ConnectTimeout := 250; //250ms otherwise too much delay? todo: seperate ping/connnect thread - chn.Connect; - chn.TryUpgradeToWebsocket; - except - //just try + try + if ws <> nil then + ws.LastActivityTime := Now; + chn.ConnectTimeout := 250; //250ms otherwise too much delay? todo: seperate ping/connnect thread + chn.TryUpgradeToWebsocket; + except + //just try + end; + finally + chn.Unlock; end; end; end; @@ -1194,6 +1212,8 @@ begin chn := TIdHTTPWebsocketClient(l.Items[i]); //valid? if //not chn.Busy and also take busy channels (will be ignored later), otherwise we have to break/reset for each RO function execution + (chn.IOHandler <> nil) and + (chn.IOHandler.IsWebsocket) and (chn.Socket <> nil) and (chn.Socket.Binding <> nil) and (chn.Socket.Binding.Handle > 0) and diff --git a/IdIOHandlerWebsocket.pas b/IdIOHandlerWebsocket.pas index 95904db..2404c2a 100644 --- a/IdIOHandlerWebsocket.pas +++ b/IdIOHandlerWebsocket.pas @@ -234,6 +234,18 @@ procedure TIdIOHandlerWebsocket.Clear; begin FWSInputBuffer.Clear; InputBuffer.Clear; + FBusyUpgrading := False; + FIsWebsocket := False; + FClosing := False; + FClosing := False; + FExtensionBits := []; + FCloseReason := ''; + FCloseCode := 0; + FLastActivityTime := 0; + FLastPingTime := 0; + FWriteTextToTarget := False; + FCloseCodeSend := False; + FPendingWriteCount := 0; end; procedure TIdIOHandlerWebsocket.Close; diff --git a/IdServerWebsocketHandling.pas b/IdServerWebsocketHandling.pas index 04bbe29..6ed78a9 100644 --- a/IdServerWebsocketHandling.pas +++ b/IdServerWebsocketHandling.pas @@ -133,7 +133,7 @@ begin Assert(aSocketIOHandler <> nil); aSocketIOHandler.WriteDisConnect(context); end; - + context.IOHandler.Clear; AThread.Data := nil; end; end;