cmueller/DelphiWebsockets
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

unit test for plain http + websockets added

Browse source 
improved (automatic) connection handling
This commit is contained in:
André Mussche 2014-02-10 11:30:56 +01:00
parent 49087c6eaa
commit 41beb829a0
5 changed files with 158 additions and 34 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
DUnit/UnitTestWebsockets.dpr
View file

@ -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

96
DUnit/mtTestWebSockets.pas
View file

@ -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.

78
IdHTTPWebsocketClient.pas
View file

@ -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

12
IdIOHandlerWebsocket.pas
View file

@ -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;

2
IdServerWebsocketHandling.pas
View file

@ -133,7 +133,7 @@ begin
Assert(aSocketIOHandler <> nil);
aSocketIOHandler.WriteDisConnect(context);
end;
context.IOHandler.Clear;
AThread.Data := nil;
end;
end;