error handling and unit test

This commit is contained in:
andremussche 2013-11-18 14:27:13 +01:00
parent cb2855115f
commit be087753c5
19 changed files with 10293 additions and 1101 deletions

22
.gitattributes vendored Normal file
View file

@ -0,0 +1,22 @@
# Auto detect text files and perform LF normalization
* text=auto
# Custom for Visual Studio
*.cs diff=csharp
*.sln merge=union
*.csproj merge=union
*.vbproj merge=union
*.fsproj merge=union
*.dbproj merge=union
# Standard to msysgit
*.doc diff=astextplain
*.DOC diff=astextplain
*.docx diff=astextplain
*.DOCX diff=astextplain
*.dot diff=astextplain
*.DOT diff=astextplain
*.pdf diff=astextplain
*.PDF diff=astextplain
*.rtf diff=astextplain
*.RTF diff=astextplain

220
.gitignore vendored Normal file
View file

@ -0,0 +1,220 @@
#################
## Eclipse
#################
*.pydevproject
.project
.metadata
bin/
tmp/
*.tmp
*.bak
*.swp
*~.nib
local.properties
.classpath
.settings/
.loadpath
dcu/
*.dproj
*.local
*.skincfg
# External tool builders
.externalToolBuilders/
# Locally stored "Eclipse launch configurations"
*.launch
# CDT-specific
.cproject
# PDT-specific
.buildpath
#################
## Visual Studio
#################
## Ignore Visual Studio temporary files, build results, and
## files generated by popular Visual Studio add-ons.
# User-specific files
*.suo
*.user
*.sln.docstates
# Build results
[Dd]ebug/
[Rr]elease/
x64/
build/
[Bb]in/
[Oo]bj/
# MSTest test Results
[Tt]est[Rr]esult*/
[Bb]uild[Ll]og.*
*_i.c
*_p.c
*.ilk
*.meta
*.obj
*.pch
*.pdb
*.pgc
*.pgd
*.rsp
*.sbr
*.tlb
*.tli
*.tlh
*.tmp
*.tmp_proj
*.log
*.vspscc
*.vssscc
.builds
*.pidb
*.log
*.scc
# Visual C++ cache files
ipch/
*.aps
*.ncb
*.opensdf
*.sdf
*.cachefile
# Visual Studio profiler
*.psess
*.vsp
*.vspx
# Guidance Automation Toolkit
*.gpState
# ReSharper is a .NET coding add-in
_ReSharper*/
*.[Rr]e[Ss]harper
# TeamCity is a build add-in
_TeamCity*
# DotCover is a Code Coverage Tool
*.dotCover
# NCrunch
*.ncrunch*
.*crunch*.local.xml
# Installshield output folder
[Ee]xpress/
# DocProject is a documentation generator add-in
DocProject/buildhelp/
DocProject/Help/*.HxT
DocProject/Help/*.HxC
DocProject/Help/*.hhc
DocProject/Help/*.hhk
DocProject/Help/*.hhp
DocProject/Help/Html2
DocProject/Help/html
# Click-Once directory
publish/
# Publish Web Output
*.Publish.xml
*.pubxml
# NuGet Packages Directory
## TODO: If you have NuGet Package Restore enabled, uncomment the next line
#packages/
# Windows Azure Build Output
csx
*.build.csdef
# Windows Store app package directory
AppPackages/
# Others
sql/
*.Cache
ClientBin/
[Ss]tyle[Cc]op.*
~$*
*~
*.dbmdl
*.[Pp]ublish.xml
*.pfx
*.publishsettings
# RIA/Silverlight projects
Generated_Code/
# Backup & report files from converting an old project file to a newer
# Visual Studio version. Backup files are not needed, because we have git ;-)
_UpgradeReport_Files/
Backup*/
UpgradeLog*.XML
UpgradeLog*.htm
# SQL Server files
App_Data/*.mdf
App_Data/*.ldf
#############
## Windows detritus
#############
# Windows image file caches
Thumbs.db
ehthumbs.db
# Folder config file
Desktop.ini
# Recycle Bin used on file shares
$RECYCLE.BIN/
# Mac crap
.DS_Store
#############
## Python
#############
*.py[co]
# Packages
*.egg
*.egg-info
dist/
build/
eggs/
parts/
var/
sdist/
develop-eggs/
.installed.cfg
# Installer logs
pip-log.txt
# Unit test / coverage reports
.coverage
.tox
#Translations
*.mo
#Mr Developer
.mr.developer.cfg

135
DUnit/NewLibrary_Intf.pas Normal file
View file

@ -0,0 +1,135 @@
unit NewLibrary_Intf;
{----------------------------------------------------------------------------}
{ This unit was automatically generated by the RemObjects SDK after reading }
{ the RODL file associated with this project . }
{ }
{ Do not modify this unit manually, or your changes will be lost when this }
{ unit is regenerated the next time you compile the project. }
{----------------------------------------------------------------------------}
{$I RemObjects.inc}
interface
uses
{vcl:} Classes, TypInfo,
{RemObjects:} uROXMLIntf, uROClasses, uROClient, uROTypes, uROClientIntf;
const
//RBK modification: storing timestamp of generation, to be able to check version mismatch between client and server
//RBK modification, done in: "\Lib\Componenten\RemObjects SDK for Delphi\Source\CodeGen\uRODLToPascalIntf.pas"
C_GenerateDateTime = '18-09-2013 15:29:06:712 by amussche';
const
{ Library ID }
LibraryUID = '{37BBB078-915E-4B4D-B5CB-FD43C7359A58}';
TargetNamespace = '';
{ Service Interface ID's }
INewService_IID : TGUID = '{5C59475D-E65E-4634-998F-B2DE324E381B}';
type
TSeekOrigin = Classes.TSeekOrigin; // fake declaration
{ Forward declarations }
INewService = interface;
{ INewService }
INewService = interface
['{5C59475D-E65E-4634-998F-B2DE324E381B}']
function Sum(const a: Integer; const b: Integer): Integer;
function LongDurationIntermediateSocketIOResults(const aDuration_ms: Integer; const aSleep_ms: Integer): Integer;
end;
{ CoNewService }
CoNewService = class
class function Create(const aMessage: IROMessage; aTransportChannel: IROTransportChannel): INewService;
end;
{ TNewService_Proxy }
TNewService_Proxy = class(TROProxy, INewService)
protected
function __GetInterfaceName:string; override;
function Sum(const a: Integer; const b: Integer): Integer;
function LongDurationIntermediateSocketIOResults(const aDuration_ms: Integer; const aSleep_ms: Integer): Integer;
end;
implementation
uses
{vcl:} SysUtils,
{RemObjects:} uROEventRepository, uROSerializer, uRORes;
{ CoNewService }
class function CoNewService.Create(const aMessage: IROMessage; aTransportChannel: IROTransportChannel): INewService;
begin
Result := TNewService_Proxy.Create(aMessage, aTransportChannel);
end;
{ TNewService_Proxy }
function TNewService_Proxy.__GetInterfaceName:string;
begin
Result := 'NewService';
end;
function TNewService_Proxy.Sum(const a: Integer; const b: Integer): Integer;
var
lMessage: IROMessage;
lTransportChannel: IROTransportChannel;
begin
lMessage := __GetMessage;
lTransportChannel := __TransportChannel;
try
lMessage.InitializeRequestMessage(lTransportChannel, 'NewLibrary', __InterfaceName, 'Sum');
lMessage.Write('a', TypeInfo(Integer), a, []);
lMessage.Write('b', TypeInfo(Integer), b, []);
lMessage.Finalize;
lTransportChannel.Dispatch(lMessage);
lMessage.Read('Result', TypeInfo(Integer), Result, []);
finally
lMessage.UnsetAttributes(lTransportChannel);
lMessage.FreeStream;
lMessage := nil;
lTransportChannel := nil;
end;
end;
function TNewService_Proxy.LongDurationIntermediateSocketIOResults(const aDuration_ms: Integer; const aSleep_ms: Integer): Integer;
var
lMessage: IROMessage;
lTransportChannel: IROTransportChannel;
begin
lMessage := __GetMessage;
lTransportChannel := __TransportChannel;
try
lMessage.InitializeRequestMessage(lTransportChannel, 'NewLibrary', __InterfaceName, 'LongDurationIntermediateSocketIOResults');
lMessage.Write('aDuration_ms', TypeInfo(Integer), aDuration_ms, []);
lMessage.Write('aSleep_ms', TypeInfo(Integer), aSleep_ms, []);
lMessage.Finalize;
lTransportChannel.Dispatch(lMessage);
lMessage.Read('Result', TypeInfo(Integer), Result, []);
finally
lMessage.UnsetAttributes(lTransportChannel);
lMessage.FreeStream;
lMessage := nil;
lTransportChannel := nil;
end;
end;
initialization
RegisterProxyClass(INewService_IID, TNewService_Proxy);
finalization
UnregisterProxyClass(INewService_IID);
end.

90
DUnit/NewLibrary_Invk.pas Normal file
View file

@ -0,0 +1,90 @@
unit NewLibrary_Invk;
{----------------------------------------------------------------------------}
{ This unit was automatically generated by the RemObjects SDK after reading }
{ the RODL file associated with this project . }
{ }
{ Do not modify this unit manually, or your changes will be lost when this }
{ unit is regenerated the next time you compile the project. }
{----------------------------------------------------------------------------}
{$I RemObjects.inc}
interface
uses
{vcl:} Classes,
{RemObjects:} uROXMLIntf, uROServer, uROServerIntf, uROTypes, uROClientIntf,
{Generated:} NewLibrary_Intf;
type
TSeekOrigin = Classes.TSeekOrigin; // fake declaration
TNewService_Invoker = class(TROInvoker)
private
protected
public
constructor Create; override;
published
procedure Invoke_Sum(const __Instance:IInterface; const __Message:IROMessage; const __Transport:IROTransport; out __oResponseOptions:TROResponseOptions);
procedure Invoke_LongDurationIntermediateSocketIOResults(const __Instance:IInterface; const __Message:IROMessage; const __Transport:IROTransport; out __oResponseOptions:TROResponseOptions);
end;
implementation
uses
{RemObjects:} uRORes, uROClient;
{ TNewService_Invoker }
constructor TNewService_Invoker.Create;
begin
inherited Create;
FAbstract := False;
end;
procedure TNewService_Invoker.Invoke_Sum(const __Instance:IInterface; const __Message:IROMessage; const __Transport:IROTransport; out __oResponseOptions:TROResponseOptions);
{ function Sum(const a: Integer; const b: Integer): Integer; }
var
a: Integer;
b: Integer;
lResult: Integer;
begin
try
__Message.Read('a', TypeInfo(Integer), a, []);
__Message.Read('b', TypeInfo(Integer), b, []);
lResult := (__Instance as INewService).Sum(a, b);
__Message.InitializeResponseMessage(__Transport, 'NewLibrary', 'NewService', 'SumResponse');
__Message.Write('Result', TypeInfo(Integer), lResult, []);
__Message.Finalize;
__Message.UnsetAttributes(__Transport);
finally
end;
end;
procedure TNewService_Invoker.Invoke_LongDurationIntermediateSocketIOResults(const __Instance:IInterface; const __Message:IROMessage; const __Transport:IROTransport; out __oResponseOptions:TROResponseOptions);
{ function LongDurationIntermediateSocketIOResults(const aDuration_ms: Integer; const aSleep_ms: Integer): Integer; }
var
aDuration_ms: Integer;
aSleep_ms: Integer;
lResult: Integer;
begin
try
__Message.Read('aDuration_ms', TypeInfo(Integer), aDuration_ms, []);
__Message.Read('aSleep_ms', TypeInfo(Integer), aSleep_ms, []);
lResult := (__Instance as INewService).LongDurationIntermediateSocketIOResults(aDuration_ms, aSleep_ms);
__Message.InitializeResponseMessage(__Transport, 'NewLibrary', 'NewService', 'LongDurationIntermediateSocketIOResultsResponse');
__Message.Write('Result', TypeInfo(Integer), lResult, []);
__Message.Finalize;
__Message.UnsetAttributes(__Transport);
finally
end;
end;
initialization
end.

92
DUnit/NewService_Impl.pas Normal file
View file

@ -0,0 +1,92 @@
unit NewService_Impl;
{----------------------------------------------------------------------------}
{ This unit was automatically generated by the RemObjects SDK after reading }
{ the RODL file associated with this project . }
{ }
{ This is where you are supposed to code the implementation of your objects. }
{----------------------------------------------------------------------------}
{$I RemObjects.inc}
interface
uses
{vcl:} Classes, SysUtils,
{RemObjects:} uROXMLIntf, uROClientIntf, uROTypes, uROServer, uROServerIntf, uROSessions,
{Required:} uRORemoteDataModule,
{Generated:} NewLibrary_Intf;
type
{ TNewService }
TNewService = class(TRORemoteDataModule,
INewService)
private
protected
{ INewService methods }
function Sum(const a: Integer; const b: Integer): Integer;
function LongDurationIntermediateSocketIOResults(const aDuration_ms: Integer; const aSleep_ms: Integer): Integer;
end;
implementation
{$IFDEF DELPHIXE2UP}
{%CLASSGROUP 'System.Classes.TPersistent'}
{$ENDIF}
{$IFNDEF FPC}
{$R *.dfm}
{$ELSE}
{$R *.lfm}
{$ENDIF}
uses
{Generated:} NewLibrary_Invk, DateUtils, uROHTTPWebsocketServer,
IdServerSocketIOHandling;
procedure Create_NewService(out anInstance : IUnknown);
begin
anInstance := TNewService.Create(nil);
end;
var
fClassFactory: IROClassFactory;
{ TNewService }
function TNewService.LongDurationIntermediateSocketIOResults(const aDuration_ms,
aSleep_ms: Integer): Integer;
var
tstart: TDateTime;
ctx: TROTransportContext;
iCounter: Integer;
begin
tstart := Now;
iCounter := 0;
while MilliSecondsBetween(Now, tstart) < aDuration_ms do
begin
//send intermediate (!) response to client back (for progress etc)
Assert(Transport is TROTransportContext);
ctx := Transport as TROTransportContext;
Inc(iCounter);
if ctx.Context.IsSocketIO then
ctx.Context.SocketIO.SendTo(ctx.Context, IntToStr(iCounter));
Sleep(aSleep_ms);
end;
Result := iCounter;
end;
function TNewService.Sum(const a, b: Integer): Integer;
begin
Result := a + b;
end;
initialization
fClassFactory := TROClassFactory.Create('NewService', {$IFDEF FPC}@{$ENDIF}Create_NewService, TNewService_Invoker);
// RegisterForZeroConf(fClassFactory,'_NewService_rosdk._tcp.');
finalization
UnRegisterClassFactory(fClassFactory);
fClassFactory := nil;
end.

View file

@ -0,0 +1,31 @@
program UnitTestWebsockets;
{
Delphi DUnit Test Project
-------------------------
This project contains the DUnit test framework and the GUI/Console test runners.
Add "CONSOLE_TESTRUNNER" to the conditional defines entry in the project options
to use the console test runner. Otherwise the GUI test runner will be used by
default.
}
{$IFDEF CONSOLE_TESTRUNNER}
{$APPTYPE CONSOLE}
{$ENDIF}
{$R *.RES}
uses
DUnitTestRunner,
TestFramework,
mtTestWebSockets in 'mtTestWebSockets.pas',
IdHTTPWebsocketClient in '..\IdHTTPWebsocketClient.pas',
superobject in '..\superobject\superobject.pas';
begin
RegisterTest(TTestWebSockets.Suite);
DUnitTestRunner.RunRegisteredTests;
end.

Binary file not shown.

View file

@ -0,0 +1,292 @@
unit mtTestROWebSockets;
interface
uses
TestFramework, NewLibrary_Intf,
uROIndyHTTPWebsocketChannel, uROHTTPWebsocketServer,
uROJSONMessage, uRORemoteService, IdHTTPWebsocketClient,
IdServerWebsocketContext;
type
TTextCallback = reference to procedure(aText: string);
TTestROWebSockets = class(TTestCase)
private
class var ROIndyHTTPWebsocketServer1: TROIndyHTTPWebsocketServer;
class var ROIndyHTTPWebsocketChannel1: TROIndyHTTPWebsocketChannel;
class var ROJSONMessage1: TROJSONMessage;
class var RORemoteService1: TRORemoteService;
protected
FLastSocketIOMsg: string;
public
procedure SetUp; override;
procedure TearDown; override;
published
procedure CreateObjects;
procedure StartRO;
procedure TestSum;
procedure TestIntermediateProgress;
procedure DestroyObjects;
end;
implementation
uses
NewService_Impl, SysUtils, IdSocketIOHandling, superobject;
{ TTestROWebSockets }
procedure TTestROWebSockets.SetUp;
begin
inherited;
end;
//procedure TTestROWebSockets.SocketIOMsgClient(
// const AClient: TIdHTTPWebsocketClient; const aText: string; aMsgNr: Integer);
//begin
// FLastSocketIOMsg := aText;
// if Assigned(FOnSocketIOMsg) then
// FOnSocketIOMsg(aText);
//end;
//procedure TTestROWebSockets.SocketIOMsgServer(
// const AContext: TIdServerWSContext; const aText: string; aMsgNr: Integer;
// aHasCallback: Boolean);
//begin
// FLastSocketIOMsg := aText;
// if aHasCallback then
// AContext.IOHandler.WriteSocketIOResult(aMsgNr, '', aText);
//end;
procedure TTestROWebSockets.TearDown;
begin
inherited;
end;
procedure TTestROWebSockets.CreateObjects;
begin
ROIndyHTTPWebsocketServer1 := TROIndyHTTPWebsocketServer.Create(nil);
ROIndyHTTPWebsocketServer1.Port := 8099;
ROIndyHTTPWebsocketServer1.KeepAlive := True;
ROIndyHTTPWebsocketServer1.DisableNagle := True;
//SendClientAccessPolicyXml = captAllowAll
//SendCrossOriginHeader = True
ROIndyHTTPWebsocketChannel1 := TROIndyHTTPWebsocketChannel.Create(nil);
ROIndyHTTPWebsocketChannel1.Port := 8099;
ROIndyHTTPWebsocketChannel1.Host := '127.0.0.1';
ROIndyHTTPWebsocketChannel1.IndyClient.SocketIOCompatible := True;
ROJSONMessage1 := TROJSONMessage.Create(nil);
ROIndyHTTPWebsocketServer1.Dispatchers.Add;
ROIndyHTTPWebsocketServer1.Dispatchers[0].Message := ROJSONMessage1;
ROIndyHTTPWebsocketServer1.Dispatchers[0].Enabled := True;
RORemoteService1 := TRORemoteService.Create(nil);
RORemoteService1.Channel := ROIndyHTTPWebsocketChannel1;
RORemoteService1.Message := ROJSONMessage1;
end;
procedure TTestROWebSockets.DestroyObjects;
begin
ROIndyHTTPWebsocketServer1.Free;
RORemoteService1.Free;
ROIndyHTTPWebsocketChannel1.Free;
ROJSONMessage1.Free;
end;
procedure TTestROWebSockets.StartRO;
begin
ROIndyHTTPWebsocketServer1.Active := True;
ROIndyHTTPWebsocketChannel1.IndyClient.Connect;
end;
procedure TTestROWebSockets.TestIntermediateProgress;
var
iresult: Integer;
iprevious: Integer;
begin
// ROIndyHTTPWebsocketChannel1.IndyClient.OnSocketIOMsg := SocketIOMsgClient;
ROIndyHTTPWebsocketChannel1.IndyClient.SocketIO.OnSocketIOMsg :=
procedure(const ASocket: ISocketIOContext; const aText: string; const aCallback: TSocketIOCallbackObj)
var icount: Integer;
begin
FLastSocketIOMsg := aText;
icount := StrToInt(aText);
//elke keer moet counter met 1 opgehoogd worden!
//see NewService_Impl
CheckEquals(iprevious+1, icount);
iprevious := icount;
end;
FLastSocketIOMsg := '';
iprevious := 0;
// FOnSocketIOMsg :=
// procedure(aText: string)
// var icount: Integer;
// begin
// icount := StrToInt(aText);
// elke keer moet counter met 1 opgehoogd worden!
// see NewService_Impl
// CheckEquals(iprevious+1, icount);
// iprevious := icount;
// end;
iresult := (RORemoteService1 as INewService).LongDurationIntermediateSocketIOResults(
2*1000, 100);
//result = counter, dus moet overeenkomen met laatste callback
CheckEquals(iprevious, iresult);
end;
procedure TTestROWebSockets.TestSocketIOCallback;
var
received: string;
begin
//* client to server */
received := '';
ROIndyHTTPWebsocketServer1.SocketIO.OnEvent('TEST_EVENT',
procedure(const ASocket: ISocketIOContext; const aArgument: TSuperArray; const aCallbackObj: TSocketIOCallbackObj)
begin
received := aArgument.ToJson;
end);
if not ROIndyHTTPWebsocketChannel1.IndyClient.Connected then
begin
ROIndyHTTPWebsocketChannel1.IndyClient.Connect;
ROIndyHTTPWebsocketChannel1.IndyClient.UpgradeToWebsocket;
end;
ROIndyHTTPWebsocketChannel1.IndyClient.SocketIO.Emit('TEST_EVENT',
SO('test event'), nil);
MaxWait(
function: Boolean
begin
Result := received <> '';
end, 10 * 1000);
received := StringReplace(received, #13#10, '', [rfReplaceAll]);
CheckEqualsString('["test event"]', received);
//* server to client */
received := '';
ROIndyHTTPWebsocketChannel1.IndyClient.SocketIO.OnEvent('TEST_EVENT',
procedure(const ASocket: ISocketIOContext; const aArgument: TSuperArray; const aCallbackObj: TSocketIOCallbackObj)
begin
received := aArgument.ToJson;
end);
ROIndyHTTPWebsocketServer1.SocketIO.EmitEventToAll('TEST_EVENT',
SO('test event'), nil);
MaxWait(
function: Boolean
begin
Result := received <> '';
end, 10 * 1000);
received := StringReplace(received, #13#10, '', [rfReplaceAll]);
CheckEqualsString('["test event"]', received);
end;
procedure TTestROWebSockets.TestSocketIOError;
begin
//disconnect: mag geen AV's daarna geven!
ROIndyHTTPWebsocketChannel1.IndyClient.Disconnect(False);
ROIndyHTTPWebsocketChannel1.IndyClient.Connect;
ROIndyHTTPWebsocketChannel1.IndyClient.UpgradeToWebsocket;
//* client to server */
FLastSocketIOMsg := '';
ROIndyHTTPWebsocketServer1.SocketIO.OnSocketIOMsg :=
procedure(const ASocket: ISocketIOContext; const aText: string; const aCallback: TSocketIOCallbackObj)
begin
Abort;
end;
ROIndyHTTPWebsocketChannel1.IndyClient.SocketIO.Send('test message',
procedure(const ASocket: ISocketIOContext; const aJSON: ISuperObject; const aCallback: TSocketIOCallbackObj)
begin
FLastSocketIOMsg := aJSON.AsString;
end);
MaxWait(
function: Boolean
begin
Result := FLastSocketIOMsg <> '';
end, 10 * 1000);
CheckEquals('[{"Error":{"Message":"Operation aborted","Type":"EAbort"}}]', FLastSocketIOMsg);
FLastSocketIOMsg := '';
ROIndyHTTPWebsocketChannel1.IndyClient.SocketIO.Send('test message',
procedure(const ASocket: ISocketIOContext; const aJSON: ISuperObject; const aCallback: TSocketIOCallbackObj)
begin
Assert(False, 'should go to error handling callback');
FLastSocketIOMsg := 'error';
end,
procedure(const ASocket: ISocketIOContext; const aErrorClass, aErrorMessage: string)
begin
FLastSocketIOMsg := aErrorMessage;
end);
MaxWait(
function: Boolean
begin
Result := FLastSocketIOMsg <> '';
end, 10 * 1000);
CheckEquals('Operation aborted', FLastSocketIOMsg);
end;
procedure TTestROWebSockets.TestSocketIOMsg;
begin
//disconnect: mag geen AV's daarna geven!
ROIndyHTTPWebsocketChannel1.IndyClient.Disconnect(False);
ROIndyHTTPWebsocketChannel1.IndyClient.Connect;
ROIndyHTTPWebsocketChannel1.IndyClient.UpgradeToWebsocket;
//* client to server */
FLastSocketIOMsg := '';
ROIndyHTTPWebsocketServer1.SocketIO.OnSocketIOMsg :=
procedure(const ASocket: ISocketIOContext; const aText: string; const aCallback: TSocketIOCallbackObj)
begin
FLastSocketIOMsg := aText;
end;
ROIndyHTTPWebsocketChannel1.IndyClient.SocketIO.Send('test message');
MaxWait(
function: Boolean
begin
Result := FLastSocketIOMsg <> '';
end, 10 * 1000);
CheckEquals('test message', FLastSocketIOMsg);
//* server to client */
FLastSocketIOMsg := '';
ROIndyHTTPWebsocketChannel1.IndyClient.SocketIO.OnSocketIOMsg :=
procedure(const ASocket: ISocketIOContext; const aText: string; const aCallback: TSocketIOCallbackObj)
begin
FLastSocketIOMsg := aText;
end;
if ROIndyHTTPWebsocketServer1.SocketIO.SendToAll('test message') = 0 then
Check(False, 'nothing send');
MaxWait(
function: Boolean
begin
Result := FLastSocketIOMsg <> '';
end, 10 * 1000);
CheckEquals('test message', FLastSocketIOMsg);
//disconnect: mag geen AV's daarna geven!
ROIndyHTTPWebsocketChannel1.IndyClient.Disconnect(False);
ROIndyHTTPWebsocketChannel1.IndyClient.Connect;
ROIndyHTTPWebsocketChannel1.IndyClient.UpgradeToWebsocket;
ROIndyHTTPWebsocketChannel1.IndyClient.SocketIO.Send('test message');
end;
procedure TTestROWebSockets.TestSum;
var
iresult: Integer;
begin
iresult := (RORemoteService1 as INewService).Sum(1,2);
CheckEquals(1+2, iresult);
end;
end.

234
DUnit/mtTestWebSockets.pas Normal file
View file

@ -0,0 +1,234 @@
unit mtTestWebSockets;
interface
uses
TestFramework,
IdHTTPWebsocketClient, IdServerWebsocketContext, IdWebsocketServer;
type
TTextCallback = reference to procedure(aText: string);
TTestWebSockets = class(TTestCase)
private
class var IndyHTTPWebsocketServer1: TIdWebsocketServer;
class var IndyHTTPWebsocketClient1: TIdHTTPWebsocketClient;
protected
FLastSocketIOMsg: string;
public
procedure SetUp; override;
procedure TearDown; override;
published
procedure CreateObjects;
procedure StartServer;
procedure TestSocketIOMsg;
procedure TestSocketIOCallback;
procedure TestSocketIOError;
procedure DestroyObjects;
end;
TBooleanFunction = reference to function: Boolean;
function MaxWait(aProc: TBooleanFunction; aMaxWait_msec: Integer): Boolean;
implementation
uses
Windows, Forms, DateUtils, SysUtils, Classes,
IdSocketIOHandling, superobject;
function MaxWait(aProc: TBooleanFunction; aMaxWait_msec: Integer): Boolean;
var
tStart: TDateTime;
begin
tStart := Now;
Result := aProc;
while not Result and
(MilliSecondsBetween(Now, tStart) <= aMaxWait_msec) do
begin
Sleep(10);
if GetCurrentThreadId = MainThreadID then
CheckSynchronize(10);
Result := aProc;
end;
end;
{ TTestWebSockets }
procedure TTestWebSockets.SetUp;
begin
inherited;
end;
procedure TTestWebSockets.TearDown;
begin
inherited;
end;
procedure TTestWebSockets.CreateObjects;
begin
IndyHTTPWebsocketServer1 := TIdWebsocketServer.Create(nil);
IndyHTTPWebsocketServer1.DefaultPort := 8099;
IndyHTTPWebsocketServer1.KeepAlive := True;
//IndyHTTPWebsocketServer1.DisableNagle := True;
//SendClientAccessPolicyXml = captAllowAll
//SendCrossOriginHeader = True
IndyHTTPWebsocketClient1 := TIdHTTPWebsocketClient.Create(nil);
IndyHTTPWebsocketClient1.Host := 'localhost';
IndyHTTPWebsocketClient1.Port := 8099;
IndyHTTPWebsocketClient1.SocketIOCompatible := True;
end;
procedure TTestWebSockets.DestroyObjects;
begin
IndyHTTPWebsocketClient1.Free;
IndyHTTPWebsocketServer1.Free;
end;
procedure TTestWebSockets.StartServer;
begin
IndyHTTPWebsocketServer1.Active := True;
end;
procedure TTestWebSockets.TestSocketIOCallback;
var
received: string;
begin
//* client to server */
received := '';
IndyHTTPWebsocketServer1.SocketIO.OnEvent('TEST_EVENT',
procedure(const ASocket: ISocketIOContext; const aArgument: TSuperArray; const aCallbackObj: TSocketIOCallbackObj)
begin
received := aArgument.ToJson;
end);
if not IndyHTTPWebsocketClient1.Connected then
begin
IndyHTTPWebsocketClient1.Connect;
IndyHTTPWebsocketClient1.UpgradeToWebsocket;
end;
IndyHTTPWebsocketClient1.SocketIO.Emit('TEST_EVENT',
SO('test event'), nil);
MaxWait(
function: Boolean
begin
Result := received <> '';
end, 10 * 1000);
received := StringReplace(received, #13#10, '', [rfReplaceAll]);
CheckEqualsString('["test event"]', received);
//* server to client */
received := '';
IndyHTTPWebsocketClient1.SocketIO.OnEvent('TEST_EVENT',
procedure(const ASocket: ISocketIOContext; const aArgument: TSuperArray; const aCallbackObj: TSocketIOCallbackObj)
begin
received := aArgument.ToJson;
end);
IndyHTTPWebsocketServer1.SocketIO.EmitEventToAll('TEST_EVENT',
SO('test event'), nil);
MaxWait(
function: Boolean
begin
Result := received <> '';
end, 10 * 1000);
received := StringReplace(received, #13#10, '', [rfReplaceAll]);
CheckEqualsString('["test event"]', received);
end;
procedure TTestWebSockets.TestSocketIOError;
begin
//disconnect: mag geen AV's daarna geven!
IndyHTTPWebsocketClient1.Disconnect(False);
IndyHTTPWebsocketClient1.Connect;
IndyHTTPWebsocketClient1.UpgradeToWebsocket;
//* client to server */
FLastSocketIOMsg := '';
IndyHTTPWebsocketServer1.SocketIO.OnSocketIOMsg :=
procedure(const ASocket: ISocketIOContext; const aText: string; const aCallback: TSocketIOCallbackObj)
begin
Abort;
end;
IndyHTTPWebsocketClient1.SocketIO.Send('test message',
procedure(const ASocket: ISocketIOContext; const aJSON: ISuperObject; const aCallback: TSocketIOCallbackObj)
begin
FLastSocketIOMsg := aJSON.AsString;
end);
MaxWait(
function: Boolean
begin
Result := FLastSocketIOMsg <> '';
end, 10 * 1000);
CheckEquals('[{"Error":{"Message":"Operation aborted","Type":"EAbort"}}]', FLastSocketIOMsg);
FLastSocketIOMsg := '';
IndyHTTPWebsocketClient1.SocketIO.Send('test message',
procedure(const ASocket: ISocketIOContext; const aJSON: ISuperObject; const aCallback: TSocketIOCallbackObj)
begin
Assert(False, 'should go to error handling callback');
FLastSocketIOMsg := 'error';
end,
procedure(const ASocket: ISocketIOContext; const aErrorClass, aErrorMessage: string)
begin
FLastSocketIOMsg := aErrorMessage;
end);
MaxWait(
function: Boolean
begin
Result := FLastSocketIOMsg <> '';
end, 10 * 1000);
CheckEquals('Operation aborted', FLastSocketIOMsg);
end;
procedure TTestWebSockets.TestSocketIOMsg;
begin
//disconnect: mag geen AV's daarna geven!
IndyHTTPWebsocketClient1.Disconnect(False);
IndyHTTPWebsocketClient1.Connect;
IndyHTTPWebsocketClient1.UpgradeToWebsocket;
//* client to server */
FLastSocketIOMsg := '';
IndyHTTPWebsocketServer1.SocketIO.OnSocketIOMsg :=
procedure(const ASocket: ISocketIOContext; const aText: string; const aCallback: TSocketIOCallbackObj)
begin
FLastSocketIOMsg := aText;
end;
IndyHTTPWebsocketClient1.SocketIO.Send('test message');
MaxWait(
function: Boolean
begin
Result := FLastSocketIOMsg <> '';
end, 10 * 1000);
CheckEquals('test message', FLastSocketIOMsg);
//* server to client */
FLastSocketIOMsg := '';
IndyHTTPWebsocketClient1.SocketIO.OnSocketIOMsg :=
procedure(const ASocket: ISocketIOContext; const aText: string; const aCallback: TSocketIOCallbackObj)
begin
FLastSocketIOMsg := aText;
end;
if IndyHTTPWebsocketServer1.SocketIO.SendToAll('test message') = 0 then
Check(False, 'nothing send');
MaxWait(
function: Boolean
begin
Result := FLastSocketIOMsg <> '';
end, 10 * 1000);
CheckEquals('test message', FLastSocketIOMsg);
//disconnect: mag geen AV's daarna geven!
IndyHTTPWebsocketClient1.Disconnect(False);
IndyHTTPWebsocketClient1.Connect;
IndyHTTPWebsocketClient1.UpgradeToWebsocket;
IndyHTTPWebsocketClient1.SocketIO.Send('test message');
end;
end.

View file

@ -4,7 +4,13 @@ interface
uses
Classes,
IdHTTP, IdHashSHA1, IdIOHandler,
IdHTTP,
{$IF CompilerVersion <= 21.0} //D2010
IdHashSHA1,
{$else}
IdHashSHA, //XE3 etc
{$IFEND}
IdIOHandler,
IdIOHandlerWebsocket, ExtCtrls, IdWinsock2, Generics.Collections, SyncObjs,
IdSocketIOHandling;
@ -147,8 +153,7 @@ implementation
uses
IdCoderMIME, SysUtils, Math, IdException, IdStackConsts, IdStack,
IdStackBSDBase, IdGlobal, Windows, StrUtils, mcBaseNamedThread,
mcFinalizationHelper;
IdStackBSDBase, IdGlobal, Windows, StrUtils;
//type
// TAnonymousThread = class(TThread)
@ -187,6 +192,7 @@ begin
FHash := TIdHashSHA1.Create;
IOHandler := TIdIOHandlerWebsocket.Create(nil);
IOHandler.UseNagle := False;
ManagedIOHandler := True;
FSocketIO := TIdSocketIOHandling_Ext.Create;
@ -216,19 +222,16 @@ end;
procedure TIdHTTPWebsocketClient.AsyncDispatchEvent(const aEvent: string);
begin
if FSocketIOCompatible then
FSocketIO.ProcessSocketIORequest(FSocketIOContext as TSocketIOContext, aEvent)
else
begin
if not Assigned(OnTextData) then Exit;
//events during dispatch? channel is busy so offload event dispatching to different thread!
TIdWebsocketDispatchThread.Instance.QueueEvent(
procedure
begin
if Assigned(OnTextData) then
OnTextData(aEvent);
end);
end;
//if not Assigned(OnTextData) then Exit;
//events during dispatch? channel is busy so offload event dispatching to different thread!
TIdWebsocketDispatchThread.Instance.QueueEvent(
procedure
begin
if FSocketIOCompatible then
FSocketIO.ProcessSocketIORequest(FSocketIOContext as TSocketIOContext, aEvent)
else if Assigned(OnTextData) then
OnTextData(aEvent);
end);
end;
destructor TIdHTTPWebsocketClient.Destroy;
@ -467,6 +470,10 @@ begin
CheckForGracefulDisconnect(True);
CheckConnected;
Assert(Self.Connected);
if Response.ResponseCode = 0 then
Response.ResponseText := Response.ResponseText;
if Response.ResponseCode <> 200{ok} then
begin
aFailedReason := Format('Error while upgrading: "%d: %s"',[ResponseCode, ResponseText]);
@ -895,9 +902,11 @@ end;
procedure TIdWebsocketMultiReadThread.BreakSelectWait;
var
iResult: Integer;
//iResult: Integer;
LAddr: TSockAddrIn6;
begin
if FTempHandle = 0 then Exit;
FillChar(LAddr, SizeOf(LAddr), 0);
//Id_IPv4
with PSOCKADDR(@LAddr)^ do
@ -915,17 +924,19 @@ begin
//The only(?) other possibility is to make a "socket pair" and send a byte to it,
//but this requires a dynamic server socket (which can trigger a firewall
//exception/question popup in WindowsXP+)
iResult := IdWinsock2.connect(FTempHandle, PSOCKADDR(@LAddr), SIZE_TSOCKADDRIN);
//iResult :=
IdWinsock2.connect(FTempHandle, PSOCKADDR(@LAddr), SIZE_TSOCKADDRIN);
//non blocking socket, so will always result in "would block"!
if (iResult <> Id_SOCKET_ERROR) or
( (GStack <> nil) and (GStack.WSGetLastError <> WSAEWOULDBLOCK) )
then
GStack.CheckForSocketError(iResult);
// if (iResult <> Id_SOCKET_ERROR) or
// ( (GStack <> nil) and (GStack.WSGetLastError <> WSAEWOULDBLOCK) )
// then
// GStack.CheckForSocketError(iResult);
end;
destructor TIdWebsocketMultiReadThread.Destroy;
begin
IdWinsock2.closesocket(FTempHandle);
FTempHandle := 0;
FChannels.Free;
inherited;
end;
@ -963,8 +974,7 @@ end;
class function TIdWebsocketMultiReadThread.Instance: TIdWebsocketMultiReadThread;
begin
if (FInstance = nil) and
not TFinalizationHelper.ApplicationIsTerminating then
if (FInstance = nil) then
begin
FInstance := TIdWebsocketMultiReadThread.Create(True);
FInstance.Start;
@ -1126,6 +1136,7 @@ begin
FPendingBreak := False;
IdWinsock2.closesocket(FTempHandle);
FTempHandle := 0;
InitSpecialEventSocket;
end;
@ -1203,8 +1214,16 @@ class function TIdWebsocketDispatchThread.Instance: TIdWebsocketDispatchThread;
begin
if FInstance = nil then
begin
FInstance := TIdWebsocketDispatchThread.Create(True);
FInstance.Start;
GlobalNameSpace.BeginWrite;
try
if FInstance = nil then
begin
FInstance := TIdWebsocketDispatchThread.Create(True);
FInstance.Start;
end;
finally
GlobalNameSpace.EndWrite;
end;
end;
Result := FInstance;
end;
@ -1231,7 +1250,8 @@ finalization
if TIdWebsocketMultiReadThread.FInstance <> nil then
begin
TIdWebsocketMultiReadThread.Instance.Terminate;
TBaseNamedThread.WaitForThread(TIdWebsocketMultiReadThread.Instance, 5 * 1000);
TIdWebsocketMultiReadThread.Instance.WaitFor;
// TBaseNamedThread.WaitForThread(TIdWebsocketMultiReadThread.Instance, 5 * 1000);
TIdWebsocketMultiReadThread.RemoveInstance;
end;

View file

@ -35,7 +35,7 @@ type
FWriteTextToTarget: Boolean;
FCloseCodeSend: Boolean;
function InternalReadDataFromSource(var VBuffer: TIdBytes): Integer;
function InternalReadDataFromSource(var VBuffer: TIdBytes; ARaiseExceptionOnTimeout: Boolean): Integer;
function ReadDataFromSource(var VBuffer: TIdBytes): Integer; override;
function WriteDataToTarget (const ABuffer: TIdBytes; const AOffset, ALength: Integer): Integer; override;
@ -228,8 +228,10 @@ begin
end;
function TIdIOHandlerWebsocket.InternalReadDataFromSource(
var VBuffer: TIdBytes): Integer;
var VBuffer: TIdBytes; ARaiseExceptionOnTimeout: Boolean): Integer;
begin
SetLength(VBuffer, 0);
CheckForDisconnect;
if not Readable(ReadTimeout) or
not Opened or
@ -241,7 +243,10 @@ begin
else if not SourceIsAvailable then
EIdClosedSocket.Toss(RSStatusDisconnected);
GStack.CheckForSocketError(GStack.WSGetLastError); //check for socket error
EIdReadTimeout.Toss(RSIdNoDataToRead); //exit, no data can be received
if ARaiseExceptionOnTimeout then
EIdReadTimeout.Toss(RSIdNoDataToRead) //exit, no data can be received
else
Exit;
end;
SetLength(VBuffer, RecvBufferSize);
@ -390,7 +395,8 @@ begin
opcodes. *)
lFirstDataCode := wdcNone;
FMessageStream.Clear;
repeat
repeat
//read a single frame
iReadCount := ReadFrame(bFIN, bRSV1, bRSV2, bRSV3, lDataCode, iaReadBuffer);
if (iReadCount > 0) or
@ -515,8 +521,10 @@ var
while FWSInputBuffer.Size <= iInputPos do
begin
//FWSInputBuffer.AsString;
InternalReadDataFromSource(temp);
InternalReadDataFromSource(temp, True);
FWSInputBuffer.Write(temp);
if FWSInputBuffer.Size <= iInputPos then
Sleep(1);
end;
//Self.ReadByte copies all data everytime (because the first byte must be removed) so we use index (much more efficient)
@ -531,8 +539,10 @@ var
begin
while FWSInputBuffer.Size < aCount do
begin
InternalReadDataFromSource(temp);
InternalReadDataFromSource(temp, True);
FWSInputBuffer.Write(temp);
if FWSInputBuffer.Size < aCount then
Sleep(1);
end;
FWSInputBuffer.ExtractToBytes(Result, aCount);

View file

@ -26,7 +26,10 @@ function TIdServerIOHandlerWebsocket.Accept(ASocket: TIdSocketHandle;
begin
Result := inherited Accept(ASocket, AListenerThread, AYarn);
if Result <> nil then
begin
(Result as TIdIOHandlerWebsocket).IsServerSide := True; //server must not mask, only client
(Result as TIdIOHandlerWebsocket).UseNagle := False;
end;
end;
procedure TIdServerIOHandlerWebsocket.InitComponent;
@ -40,7 +43,10 @@ function TIdServerIOHandlerWebsocket.MakeClientIOHandler(
begin
Result := inherited MakeClientIOHandler(ATheThread);
if Result <> nil then
begin
(Result as TIdIOHandlerWebsocket).IsServerSide := True; //server must not mask, only client
(Result as TIdIOHandlerWebsocket).UseNagle := False;
end;
end;
end.

View file

@ -13,14 +13,14 @@ type
protected
procedure ProcessHeatbeatRequest(const AContext: TSocketIOContext; const aText: string); override;
public
function SendToAll(const aMessage: string; const aCallback: TSocketIOMsgJSON = nil): Integer;
procedure SendTo (const aContext: TIdServerContext; const aMessage: string; const aCallback: TSocketIOMsgJSON = nil);
function SendToAll(const aMessage: string; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil): Integer;
procedure SendTo (const aContext: TIdServerContext; const aMessage: string; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);
function EmitEventToAll(const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil): Integer;
function EmitEventToAll(const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil): Integer;
procedure EmitEventTo (const aContext: TSocketIOContext;
const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil);overload;
const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);overload;
procedure EmitEventTo (const aContext: TIdServerContext;
const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil);overload;
const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);overload;
end;
implementation
@ -32,7 +32,7 @@ uses
procedure TIdServerSocketIOHandling.EmitEventTo(
const aContext: TSocketIOContext; const aEventName: string;
const aData: ISuperObject; const aCallback: TSocketIOMsgJSON);
const aData: ISuperObject; const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
var
jsonarray: string;
begin
@ -47,32 +47,32 @@ begin
jsonarray := '[' + aData.AsString + ']';
if not Assigned(aCallback) then
WriteSocketIOEvent(aContext, ''{no room}, aEventName, jsonarray, nil)
WriteSocketIOEvent(aContext, ''{no room}, aEventName, jsonarray, nil, nil)
else
WriteSocketIOEventRef(aContext, ''{no room}, aEventName, jsonarray,
procedure(const aData: string)
begin
aCallback(aContext, SO(aData), nil);
end);
end, aOnError);
end;
procedure TIdServerSocketIOHandling.EmitEventTo(
const aContext: TIdServerContext; const aEventName: string;
const aData: ISuperObject; const aCallback: TSocketIOMsgJSON);
const aData: ISuperObject; const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
var
context: TSocketIOContext;
begin
Lock;
try
context := FConnections.Items[aContext];
EmitEventTo(context, aEventName, aData, aCallback);
EmitEventTo(context, aEventName, aData, aCallback, aOnError);
finally
UnLock;
end;
end;
function TIdServerSocketIOHandling.EmitEventToAll(const aEventName: string; const aData: ISuperObject;
const aCallback: TSocketIOMsgJSON): Integer;
const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError): Integer;
var
context: TSocketIOContext;
jsonarray: string;
@ -92,13 +92,13 @@ begin
if context.IsDisconnected then Continue;
if not Assigned(aCallback) then
WriteSocketIOEvent(context, ''{no room}, aEventName, jsonarray, nil)
WriteSocketIOEvent(context, ''{no room}, aEventName, jsonarray, nil, nil)
else
WriteSocketIOEventRef(context, ''{no room}, aEventName, jsonarray,
procedure(const aData: string)
begin
aCallback(context, SO(aData), nil);
end);
end, aOnError);
Inc(Result);
end;
for context in FConnectionsGUID.Values do
@ -106,13 +106,13 @@ begin
if context.IsDisconnected then Continue;
if not Assigned(aCallback) then
WriteSocketIOEvent(context, ''{no room}, aEventName, jsonarray, nil)
WriteSocketIOEvent(context, ''{no room}, aEventName, jsonarray, nil, nil)
else
WriteSocketIOEventRef(context, ''{no room}, aEventName, jsonarray,
procedure(const aData: string)
begin
aCallback(context, SO(aData), nil);
end);
end, aOnError);
Inc(Result);
end;
finally
@ -127,7 +127,7 @@ begin
end;
procedure TIdServerSocketIOHandling.SendTo(const aContext: TIdServerContext;
const aMessage: string; const aCallback: TSocketIOMsgJSON);
const aMessage: string; const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
var
context: TSocketIOContext;
begin
@ -144,14 +144,14 @@ begin
procedure(const aData: string)
begin
aCallback(context, SO(aData), nil);
end);
end, aOnError);
finally
UnLock;
end;
end;
function TIdServerSocketIOHandling.SendToAll(const aMessage: string;
const aCallback: TSocketIOMsgJSON): Integer;
const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError): Integer;
var
context: TSocketIOContext;
begin
@ -169,7 +169,7 @@ begin
procedure(const aData: string)
begin
aCallback(context, SO(aData), nil);
end);
end, aOnError);
Inc(Result);
end;
for context in FConnectionsGUID.Values do

View file

@ -75,7 +75,7 @@ end;
function TIdServerWSContext.IsSocketIO: Boolean;
begin
//FDocument = '/socket.io/1/websocket/13412152'
Result := StartsText('/socket.io/1/websocket', FPath);
Result := StartsText('/socket.io/1/websocket/', FPath);
end;
end.

View file

@ -3,7 +3,12 @@ unit IdServerWebsocketHandling;
interface
uses
IdContext, IdCustomHTTPServer, IdHashSHA1,
IdContext, IdCustomHTTPServer,
{$IF CompilerVersion <= 21.0} //D2010
IdHashSHA1,
{$else}
IdHashSHA, //XE3 etc
{$IFEND}
IdServerSocketIOHandling, IdServerWebsocketContext,
Classes, IdServerBaseHandling, IdIOHandlerWebsocket;
@ -263,9 +268,12 @@ begin
if (sValue <> '') then
begin
context.WebSocketVersion := StrToIntDef(sValue, 0);
if context.WebSocketVersion < 13 then
Abort; //must be at least 13
end
if context.WebSocketVersion < 13 then
Abort; //must be at least 13
end
else
Abort; //must exist

View file

@ -19,6 +19,7 @@ type
TSocketIOMsgJSON = reference to procedure(const ASocket: ISocketIOContext; const aJSON: ISuperObject; const aCallback: TSocketIOCallbackObj);
TSocketIONotify = reference to procedure(const ASocket: ISocketIOContext);
TSocketIOEvent = reference to procedure(const ASocket: ISocketIOContext; const aArgument: TSuperArray; const aCallbackObj: TSocketIOCallbackObj);
TSocketIOError = reference to procedure(const ASocket: ISocketIOContext; const aErrorClass, aErrorMessage: string);
TSocketIONotifyList = class(TList<TSocketIONotify>);
TSocketIOEventList = class(TList<TSocketIOEvent>);
@ -31,9 +32,9 @@ type
function PeerIP: string;
function PeerPort: Integer;
procedure EmitEvent(const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil);
procedure Send(const aData: string; const aCallback: TSocketIOMsgJSON = nil);
procedure SendJSON(const aJSON: ISuperObject; const aCallback: TSocketIOMsgJSON = nil);
procedure EmitEvent(const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);
procedure Send(const aData: string; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);
procedure SendJSON(const aJSON: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);
end;
TSocketIOContext = class(TInterfacedObject,
@ -78,10 +79,10 @@ type
//todo: OnEvent per socket
//todo: store session info per connection (see Socket.IO Set + Get -> Storing data associated to a client)
//todo: namespace using "Of"
procedure EmitEvent(const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil);
procedure EmitEvent(const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);
// procedure BroadcastEventToOthers(const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil);
procedure Send(const aData: string; const aCallback: TSocketIOMsgJSON = nil);
procedure SendJSON(const aJSON: ISuperObject; const aCallback: TSocketIOMsgJSON = nil);
procedure Send(const aData: string; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);
procedure SendJSON(const aJSON: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);
end;
TSocketIOCallbackObj = class
@ -91,6 +92,7 @@ type
FMsgNr: Integer;
public
procedure SendResponse(const aResponse: string);
function IsResponseSend: Boolean;
end;
TIdBaseSocketIOHandling = class(TIdServerBaseHandling)
@ -113,6 +115,7 @@ type
FSocketIOMsgNr: Integer;
FSocketIOEventCallback: TDictionary<Integer,TSocketIOCallback>;
FSocketIOEventCallbackRef: TDictionary<Integer,TSocketIOCallbackRef>;
FSocketIOErrorRef: TDictionary<Integer,TSocketIOError>;
function WriteConnect(const ASocket: TSocketIOContext): string; overload;
procedure WriteDisConnect(const ASocket: TSocketIOContext);overload;
@ -122,10 +125,10 @@ type
procedure WriteDisConnect(const AContext: TIdContext);overload;
procedure WritePing(const AContext: TIdContext);overload;
procedure WriteSocketIOMsg(const ASocket: TSocketIOContext; const aRoom, aData: string; aCallback: TSocketIOCallbackRef = nil);
procedure WriteSocketIOJSON(const ASocket: TSocketIOContext; const aRoom, aJSON: string; aCallback: TSocketIOCallbackRef = nil);
procedure WriteSocketIOEvent(const ASocket: TSocketIOContext; const aRoom, aEventName, aJSONArray: string; aCallback: TSocketIOCallback);
procedure WriteSocketIOEventRef(const ASocket: TSocketIOContext; const aRoom, aEventName, aJSONArray: string; aCallback: TSocketIOCallbackRef);
procedure WriteSocketIOMsg(const ASocket: TSocketIOContext; const aRoom, aData: string; aCallback: TSocketIOCallbackRef = nil; const aOnError: TSocketIOError = nil);
procedure WriteSocketIOJSON(const ASocket: TSocketIOContext; const aRoom, aJSON: string; aCallback: TSocketIOCallbackRef = nil; const aOnError: TSocketIOError = nil);
procedure WriteSocketIOEvent(const ASocket: TSocketIOContext; const aRoom, aEventName, aJSONArray: string; aCallback: TSocketIOCallback; const aOnError: TSocketIOError);
procedure WriteSocketIOEventRef(const ASocket: TSocketIOContext; const aRoom, aEventName, aJSONArray: string; aCallback: TSocketIOCallbackRef; const aOnError: TSocketIOError);
procedure WriteSocketIOResult(const ASocket: TSocketIOContext; aRequestMsgNr: Integer; const aRoom, aData: string);
procedure ProcessSocketIO_XHR(const aGUID: string; const aStrmRequest, aStrmResponse: TStream);
@ -160,8 +163,8 @@ type
TIdSocketIOHandling = class(TIdBaseSocketIOHandling)
public
procedure Send(const aMessage: string; const aCallback: TSocketIOMsgJSON = nil);
procedure Emit(const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil);
procedure Send(const aMessage: string; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);
procedure Emit(const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);
end;
implementation
@ -181,6 +184,7 @@ begin
FSocketIOEventCallback := TDictionary<Integer,TSocketIOCallback>.Create;
FSocketIOEventCallbackRef := TDictionary<Integer,TSocketIOCallbackRef>.Create;
FSocketIOErrorRef := TDictionary<Integer,TSocketIOError>.Create;
end;
destructor TIdBaseSocketIOHandling.Destroy;
@ -189,6 +193,7 @@ var squid: string;
begin
FSocketIOEventCallback.Free;
FSocketIOEventCallbackRef.Free;
FSocketIOErrorRef.Free;
FOnEventList.Free;
FOnConnectionList.Free;
@ -348,7 +353,7 @@ procedure TIdBaseSocketIOHandling.ProcessCloseChannel(
begin
if aChannel <> '' then
//todo: close channel
else
else if (ASocket.FContext <> nil) then
ASocket.FContext.Connection.Disconnect;
end;
@ -576,6 +581,8 @@ var
callback: TSocketIOCallback;
callbackref: TSocketIOCallbackRef;
callbackobj: TSocketIOCallbackObj;
errorref: TSocketIOError;
error: ISuperObject;
begin
if not FConnections.ContainsValue(ASocket) and
not FConnectionsGUID.ContainsValue(ASocket) then
@ -640,7 +647,15 @@ begin
callbackobj.FHandling := Self;
callbackobj.FSocket := ASocket;
callbackobj.FMsgNr := imsg;
try
OnSocketIOMsg(ASocket, sdata, callbackobj); //, imsg, bCallback);
except
on E:Exception do
begin
if not callbackobj.IsResponseSend then
callbackobj.SendResponse( SO(['Error', SO(['Type', e.ClassName, 'Message', e.Message])]).AsJSon );
end;
end;
finally
callbackobj.Free;
end
@ -665,7 +680,15 @@ begin
callbackobj.FHandling := Self;
callbackobj.FSocket := ASocket;
callbackobj.FMsgNr := imsg;
try
OnSocketIOJson(ASocket, SO(sdata), callbackobj); //, imsg, bCallback);
except
on E:Exception do
begin
if not callbackobj.IsResponseSend then
callbackobj.SendResponse( SO(['Error', SO(['Type', e.ClassName, 'Message', e.Message])]).AsJSon );
end;
end;
finally
callbackobj.Free;
end
@ -700,6 +723,24 @@ begin
imsg := StrToIntDef(smsg, 0);
sData := Copy(sdata, Pos('+', sData)+1, Length(sData));
if FSocketIOErrorRef.TryGetValue(imsg, errorref) then
begin
FSocketIOErrorRef.Remove(imsg);
//'[{"Error":{"Message":"Operation aborted","Type":"EAbort"}}]'
if ContainsText(sdata, '{"Error":') then
begin
error := SO(sdata);
if error.IsType(stArray) then
error := error.O['0'];
error := error.O['Error'];
if error.S['Message'] <> '' then
errorref(ASocket, error.S['Type'], error.S['Message'])
else
errorref(ASocket, 'Unknown', sdata);
Exit;
end;
end;
if FSocketIOEventCallback.TryGetValue(imsg, callback) then
begin
FSocketIOEventCallback.Remove(imsg);
@ -782,7 +823,7 @@ begin
end;
procedure TIdBaseSocketIOHandling.WriteSocketIOEvent(const ASocket: TSocketIOContext; const aRoom, aEventName,
aJSONArray: string; aCallback: TSocketIOCallback);
aJSONArray: string; aCallback: TSocketIOCallback; const aOnError: TSocketIOError);
var
sresult: string;
begin
@ -799,12 +840,15 @@ begin
sresult := Format('5:%d+:%s:{"name":"%s", "args":%s}',
[FSocketIOMsgNr, aRoom, aEventName, aJSONArray]);
FSocketIOEventCallback.Add(FSocketIOMsgNr, aCallback);
if Assigned(aOnError) then
FSocketIOErrorRef.Add(FSocketIOMsgNr, aOnError);
end;
WriteString(ASocket, sresult);
end;
procedure TIdBaseSocketIOHandling.WriteSocketIOEventRef(const ASocket: TSocketIOContext;
const aRoom, aEventName, aJSONArray: string; aCallback: TSocketIOCallbackRef);
const aRoom, aEventName, aJSONArray: string; aCallback: TSocketIOCallbackRef; const aOnError: TSocketIOError);
var
sresult: string;
begin
@ -821,12 +865,15 @@ begin
sresult := Format('5:%d+:%s:{"name":"%s", "args":%s}',
[FSocketIOMsgNr, aRoom, aEventName, aJSONArray]);
FSocketIOEventCallbackRef.Add(FSocketIOMsgNr, aCallback);
if Assigned(aOnError) then
FSocketIOErrorRef.Add(FSocketIOMsgNr, aOnError);
end;
WriteString(ASocket, sresult);
end;
procedure TIdBaseSocketIOHandling.WriteSocketIOJSON(const ASocket: TSocketIOContext;
const aRoom, aJSON: string; aCallback: TSocketIOCallbackRef = nil);
const aRoom, aJSON: string; aCallback: TSocketIOCallbackRef = nil; const aOnError: TSocketIOError = nil);
var
sresult: string;
begin
@ -843,13 +890,16 @@ begin
sresult := Format('4:%d+:%s:%s',
[FSocketIOMsgNr, aRoom, aJSON]);
FSocketIOEventCallbackRef.Add(FSocketIOMsgNr, aCallback);
if Assigned(aOnError) then
FSocketIOErrorRef.Add(FSocketIOMsgNr, aOnError);
end;
WriteString(ASocket, sresult);
end;
procedure TIdBaseSocketIOHandling.WriteSocketIOMsg(const ASocket: TSocketIOContext;
const aRoom, aData: string; aCallback: TSocketIOCallbackRef = nil);
const aRoom, aData: string; aCallback: TSocketIOCallbackRef = nil; const aOnError: TSocketIOError = nil);
var
sresult: string;
begin
@ -866,6 +916,9 @@ begin
sresult := Format('3:%d+:%s:%s',
[FSocketIOMsgNr, aRoom, aData]);
FSocketIOEventCallbackRef.Add(FSocketIOMsgNr, aCallback);
if Assigned(aOnError) then
FSocketIOErrorRef.Add(FSocketIOMsgNr, aOnError);
end;
WriteString(ASocket, sresult);
@ -896,7 +949,7 @@ begin
if (ASocket.FIOHandler <> nil) then
begin
Assert(ASocket.FIOHandler.IsWebsocket);
//Assert(ASocket.FIOHandler.IsWebsocket);
if DebugHook <> 0 then
Windows.OutputDebugString(PChar('Send: ' + aText));
ASocket.FIOHandler.Write(aText);
@ -915,9 +968,15 @@ end;
{ TSocketIOCallbackObj }
function TSocketIOCallbackObj.IsResponseSend: Boolean;
begin
Result := (FMsgNr < 0);
end;
procedure TSocketIOCallbackObj.SendResponse(const aResponse: string);
begin
FHandling.WriteSocketIOResult(FSocket, FMsgNr, '', aResponse);
FMsgNr := -1;
end;
{ TSocketIOContext }
@ -940,17 +999,17 @@ begin
end;
procedure TSocketIOContext.EmitEvent(const aEventName: string; const aData: ISuperObject;
const aCallback: TSocketIOMsgJSON);
const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
begin
if not Assigned(aCallback) then
FHandling.WriteSocketIOEvent(Self, '', aEventName, aData.AsJSon, nil)
FHandling.WriteSocketIOEvent(Self, '', aEventName, aData.AsJSon, nil, nil)
else
begin
FHandling.WriteSocketIOEventRef(Self, '', aEventName, aData.AsJSon,
procedure(const aData: string)
begin
aCallback(Self, SO(aData), nil);
end);
end, aOnError);
end;
end;
@ -1007,7 +1066,7 @@ begin
end;
procedure TSocketIOContext.Send(const aData: string;
const aCallback: TSocketIOMsgJSON);
const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
begin
if not Assigned(aCallback) then
FHandling.WriteSocketIOMsg(Self, '', aData)
@ -1017,12 +1076,12 @@ begin
procedure(const aData: string)
begin
aCallback(Self, SO(aData), nil);
end);
end, aOnError);
end;
end;
procedure TSocketIOContext.SendJSON(const aJSON: ISuperObject;
const aCallback: TSocketIOMsgJSON);
const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
begin
if not Assigned(aCallback) then
FHandling.WriteSocketIOJSON(Self, '', aJSON.AsJSon())
@ -1032,7 +1091,7 @@ begin
procedure(const aData: string)
begin
aCallback(Self, SO(aData), nil);
end);
end, aOnError);
end;
end;
@ -1131,7 +1190,7 @@ end;
{ TIdSocketIOHandling }
procedure TIdSocketIOHandling.Emit(const aEventName: string;
const aData: ISuperObject; const aCallback: TSocketIOMsgJSON);
const aData: ISuperObject; const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
var
context: TSocketIOContext;
jsonarray: string;
@ -1154,13 +1213,13 @@ begin
if context.IsDisconnected then Continue;
if not Assigned(aCallback) then
WriteSocketIOEvent(context, ''{no room}, aEventName, jsonarray, nil)
WriteSocketIOEvent(context, ''{no room}, aEventName, jsonarray, nil, nil)
else
WriteSocketIOEventRef(context, ''{no room}, aEventName, jsonarray,
procedure(const aData: string)
begin
aCallback(context, SO(aData), nil);
end);
end, aOnError);
Inc(isendcount);
end;
for context in FConnectionsGUID.Values do
@ -1168,13 +1227,13 @@ begin
if context.IsDisconnected then Continue;
if not Assigned(aCallback) then
WriteSocketIOEvent(context, ''{no room}, aEventName, jsonarray, nil)
WriteSocketIOEvent(context, ''{no room}, aEventName, jsonarray, nil, nil)
else
WriteSocketIOEventRef(context, ''{no room}, aEventName, jsonarray,
procedure(const aData: string)
begin
aCallback(context, SO(aData), nil);
end);
end, aOnError);
Inc(isendcount);
end;
@ -1186,7 +1245,7 @@ begin
end;
procedure TIdSocketIOHandling.Send(const aMessage: string;
const aCallback: TSocketIOMsgJSON);
const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
var
context: TSocketIOContext;
isendcount: Integer;
@ -1209,7 +1268,7 @@ begin
procedure(const aData: string)
begin
aCallback(context, SO(aData), nil);
end);
end, aOnError);
Inc(isendcount);
end;
for context in FConnectionsGUID.Values do
@ -1225,7 +1284,7 @@ begin
procedure(const aData: string)
begin
aCallback(context, SO(aData), nil);
end);
end, aOnError);
Inc(isendcount);
end;

6572
superobject/superobject.pas Normal file

File diff suppressed because it is too large Load diff

File diff suppressed because it is too large Load diff

View file

@ -405,6 +405,7 @@ procedure TROIndyHTTPSocketIOClient.AsyncDispatchEvent(const aEvent: TStream);
var
iEventNr: Integer;
cWSNR: array[0..High(C_RO_WS_NR)] of AnsiChar;
s: string;
begin
if aEvent.Size > Length(C_RO_WS_NR) + SizeOf(iEventNr) then
begin
@ -415,7 +416,16 @@ begin
if cWSNR = C_RO_WS_NR then
begin
aEvent.Read(iEventNr, SizeOf(iEventNr));
Assert(iEventNr < 0, 'must be negative number for RO events');
if iEventNr >= 0 then
begin
aEvent.Position := 0;
with TStreamReader.Create(aEvent) do
begin
s := ReadToEnd;
Free;
end;
Assert(iEventNr < 0, 'must be negative number for RO events: ' + s);
end;
//trunc
aEvent.Size := aEvent.Size - Length(C_RO_WS_NR) - SizeOf(iEventNr);