error handling and unit test
This commit is contained in:
andremussche
parent
cb2855115f
commit
be087753c5
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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.
|
||||
|
|
@ -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.
|
||||
|
|
@ -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.
|
||||
|
|
@ -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.
|
|
@ -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.
|
||||
|
||||
|
|
@ -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.
|
||||
|
||||
|
|
@ -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]);
|
||||
|
|
@ -872,7 +879,7 @@ begin
|
|||
try
|
||||
//already exists?
|
||||
if l.IndexOf(aChannel) >= 0 then Exit;
|
||||
|
||||
|
||||
Assert(l.Count < 64, 'Max 64 connections can be handled by one read thread!'); //due to restrictions of the "select" API
|
||||
l.Add(aChannel);
|
||||
|
||||
|
|
@ -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;
|
||||
|
|
@ -951,7 +962,7 @@ var
|
|||
iResult: Integer;
|
||||
begin
|
||||
if GStack = nil then Exit; //finalized?
|
||||
|
||||
|
||||
//alloc socket
|
||||
FTempHandle := GStack.NewSocketHandle(Id_SOCK_STREAM, Id_IPPROTO_IP, Id_IPv4, False);
|
||||
Assert(FTempHandle <> Id_INVALID_SOCKET);
|
||||
|
|
@ -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;
|
||||
|
|
@ -1033,7 +1043,7 @@ begin
|
|||
//ignore error during wait: socket disconnected etc
|
||||
Exit;
|
||||
|
||||
if Terminated then Exit;
|
||||
if Terminated then Exit;
|
||||
|
||||
//some data?
|
||||
if (iResult > 0) then
|
||||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load Diff
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -1,281 +1,289 @@
|
|||
unit IdServerWebsocketHandling;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
IdContext, IdCustomHTTPServer, IdHashSHA1,
|
||||
IdServerSocketIOHandling, IdServerWebsocketContext,
|
||||
Classes, IdServerBaseHandling, IdIOHandlerWebsocket;
|
||||
|
||||
type
|
||||
TIdServerSocketIOHandling_Ext = class(TIdServerSocketIOHandling)
|
||||
end;
|
||||
|
||||
TIdServerWebsocketHandling = class(TIdServerBaseHandling)
|
||||
protected
|
||||
class procedure DoWSExecute(AThread: TIdContext; aSocketIOHandler: TIdServerSocketIOHandling_Ext);virtual;
|
||||
class procedure HandleWSMessage(AContext: TIdServerWSContext; aType: TWSDataType;
|
||||
aRequestStrm, aResponseStrm: TMemoryStream;
|
||||
aSocketIOHandler: TIdServerSocketIOHandling_Ext);virtual;
|
||||
public
|
||||
class function ProcessServerCommandGet(AThread: TIdServerWSContext;
|
||||
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo): Boolean;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
StrUtils, SysUtils, IdCustomTCPServer, IdCoderMIME;
|
||||
|
||||
{ TIdServerWebsocketHandling }
|
||||
|
||||
class procedure TIdServerWebsocketHandling.DoWSExecute(AThread: TIdContext; aSocketIOHandler: TIdServerSocketIOHandling_Ext);
|
||||
var
|
||||
strmRequest, strmResponse: TMemoryStream;
|
||||
wscode: TWSDataCode;
|
||||
wstype: TWSDataType;
|
||||
context: TIdServerWSContext;
|
||||
begin
|
||||
context := nil;
|
||||
try
|
||||
context := AThread as TIdServerWSContext;
|
||||
//todo: make seperate function + do it after first real write (not header!)
|
||||
if context.IOHandler.BusyUpgrading then
|
||||
begin
|
||||
context.IOHandler.IsWebsocket := True;
|
||||
context.IOHandler.BusyUpgrading := False;
|
||||
end;
|
||||
//initial connect
|
||||
if context.IsSocketIO then
|
||||
begin
|
||||
Assert(aSocketIOHandler <> nil);
|
||||
aSocketIOHandler.WriteConnect(context);
|
||||
end;
|
||||
//AThread.Connection.Socket.UseNagle := False;
|
||||
|
||||
while AThread.Connection.Connected do
|
||||
begin
|
||||
if (AThread.Connection.IOHandler.InputBuffer.Size > 0) or
|
||||
AThread.Connection.IOHandler.Readable(5 * 1000) then //wait 5s, else ping the client(!)
|
||||
begin
|
||||
strmResponse := TMemoryStream.Create;
|
||||
strmRequest := TMemoryStream.Create;
|
||||
try
|
||||
context := AThread as TIdServerWSContext;
|
||||
|
||||
strmRequest.Position := 0;
|
||||
//first is the type: text or bin
|
||||
wscode := TWSDataCode(context.IOHandler.ReadLongWord);
|
||||
//then the length + data = stream
|
||||
context.IOHandler.ReadStream(strmRequest);
|
||||
strmRequest.Position := 0;
|
||||
//ignore ping/pong messages
|
||||
if wscode in [wdcPing, wdcPong] then
|
||||
begin
|
||||
if wscode = wdcPing then
|
||||
context.IOHandler.WriteData(nil, wdcPong);
|
||||
Continue;
|
||||
end;
|
||||
|
||||
if wscode = wdcText then
|
||||
wstype := wdtText
|
||||
else
|
||||
wstype := wdtBinary;
|
||||
|
||||
HandleWSMessage(context, wstype, strmRequest, strmResponse, aSocketIOHandler);
|
||||
|
||||
//write result back (of the same type: text or bin)
|
||||
if strmResponse.Size > 0 then
|
||||
begin
|
||||
if wscode = wdcText then
|
||||
context.IOHandler.Write(strmResponse, wdtText)
|
||||
else
|
||||
context.IOHandler.Write(strmResponse, wdtBinary)
|
||||
end
|
||||
else
|
||||
context.IOHandler.WriteData(nil, wdcPing);
|
||||
finally
|
||||
strmRequest.Free;
|
||||
strmResponse.Free;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
//ping
|
||||
if context.IsSocketIO then
|
||||
begin
|
||||
//context.SocketIOPingSend := True;
|
||||
Assert(aSocketIOHandler <> nil);
|
||||
aSocketIOHandler.WritePing(context);
|
||||
end
|
||||
else
|
||||
context.IOHandler.WriteData(nil, wdcPing);
|
||||
end;
|
||||
|
||||
end;
|
||||
finally
|
||||
if context.IsSocketIO then
|
||||
begin
|
||||
Assert(aSocketIOHandler <> nil);
|
||||
aSocketIOHandler.WriteDisConnect(context);
|
||||
end;
|
||||
|
||||
AThread.Data := nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
class procedure TIdServerWebsocketHandling.HandleWSMessage(AContext: TIdServerWSContext; aType: TWSDataType;
|
||||
aRequestStrm, aResponseStrm: TMemoryStream;
|
||||
aSocketIOHandler: TIdServerSocketIOHandling_Ext);
|
||||
begin
|
||||
if AContext.IsSocketIO then
|
||||
begin
|
||||
aRequestStrm.Position := 0;
|
||||
Assert(aSocketIOHandler <> nil);
|
||||
aSocketIOHandler.ProcessSocketIORequest(AContext, aRequestStrm);
|
||||
end
|
||||
else if Assigned(AContext.OnCustomChannelExecute) then
|
||||
AContext.OnCustomChannelExecute(AContext, aType, aRequestStrm, aResponseStrm);
|
||||
end;
|
||||
|
||||
class function TIdServerWebsocketHandling.ProcessServerCommandGet(
|
||||
AThread: TIdServerWSContext; ARequestInfo: TIdHTTPRequestInfo;
|
||||
AResponseInfo: TIdHTTPResponseInfo): Boolean;
|
||||
var
|
||||
sValue, squid: string;
|
||||
context: TIdServerWSContext;
|
||||
hash: TIdHashSHA1;
|
||||
guid: TGUID;
|
||||
begin
|
||||
(* GET /chat HTTP/1.1
|
||||
Host: server.example.com
|
||||
Upgrade: websocket
|
||||
Connection: Upgrade
|
||||
Sec-WebSocket-Key: dGhlIHNhbXBsZSBub25jZQ==
|
||||
Origin: http://example.com
|
||||
Sec-WebSocket-Protocol: chat, superchat
|
||||
Sec-WebSocket-Version: 13 *)
|
||||
|
||||
(* GET ws://echo.websocket.org/?encoding=text HTTP/1.1
|
||||
Origin: http://websocket.org
|
||||
Cookie: __utma=99as
|
||||
Connection: Upgrade
|
||||
Host: echo.websocket.org
|
||||
Sec-WebSocket-Key: uRovscZjNol/umbTt5uKmw==
|
||||
Upgrade: websocket
|
||||
Sec-WebSocket-Version: 13 *)
|
||||
|
||||
//Connection: Upgrade
|
||||
if not SameText('Upgrade', ARequestInfo.Connection) then
|
||||
begin
|
||||
//initiele ondersteuning voor socket.io
|
||||
if SameText(ARequestInfo.document , '/socket.io/1/') then
|
||||
begin
|
||||
{
|
||||
https://github.com/LearnBoost/socket.io-spec
|
||||
The client will perform an initial HTTP POST request like the following
|
||||
http://example.com/socket.io/1/
|
||||
200: The handshake was successful.
|
||||
The body of the response should contain the session id (sid) given to the client, followed by the heartbeat timeout, the connection closing timeout, and the list of supported transports separated by :
|
||||
The absence of a heartbeat timeout ('') is interpreted as the server and client not expecting heartbeats.
|
||||
For example 4d4f185e96a7b:15:10:websocket,xhr-polling.
|
||||
}
|
||||
AResponseInfo.ResponseNo := 200;
|
||||
AResponseInfo.ResponseText := 'Socket.io connect OK';
|
||||
|
||||
CreateGUID(guid);
|
||||
squid := GUIDToString(guid);
|
||||
AResponseInfo.ContentText := squid +
|
||||
':15:10:websocket,xhr-polling';
|
||||
AResponseInfo.CloseConnection := False;
|
||||
//(AThread.SocketIO as TIdServerSocketIOHandling_Ext).NewConnection(AThread);
|
||||
(AThread.SocketIO as TIdServerSocketIOHandling_Ext).NewConnection(squid, AThread.Binding.PeerIP);
|
||||
|
||||
Result := True; //handled
|
||||
end
|
||||
//'/socket.io/1/xhr-polling/2129478544'
|
||||
else if StartsText('/socket.io/1/xhr-polling/', ARequestInfo.document) then
|
||||
begin
|
||||
AResponseInfo.ContentStream := TMemoryStream.Create;
|
||||
AResponseInfo.CloseConnection := False;
|
||||
|
||||
squid := Copy(ARequestInfo.Document, 1 + Length('/socket.io/1/xhr-polling/'), Length(ARequestInfo.document));
|
||||
if ARequestInfo.CommandType = hcGET then
|
||||
(AThread.SocketIO as TIdServerSocketIOHandling_Ext)
|
||||
.ProcessSocketIO_XHR(squid, ARequestInfo.PostStream, AResponseInfo.ContentStream)
|
||||
else if ARequestInfo.CommandType = hcPOST then
|
||||
(AThread.SocketIO as TIdServerSocketIOHandling_Ext)
|
||||
.ProcessSocketIO_XHR(squid, ARequestInfo.PostStream, nil); //no response expected with POST!
|
||||
Result := True; //handled
|
||||
end
|
||||
else
|
||||
Result := False; //NOT handled
|
||||
end
|
||||
else
|
||||
begin
|
||||
Result := True; //handled
|
||||
context := AThread as TIdServerWSContext;
|
||||
|
||||
//Sec-WebSocket-Key: dGhlIHNhbXBsZSBub25jZQ==
|
||||
sValue := ARequestInfo.RawHeaders.Values['sec-websocket-key'];
|
||||
//"The value of this header field MUST be a nonce consisting of a randomly
|
||||
// selected 16-byte value that has been base64-encoded"
|
||||
unit IdServerWebsocketHandling;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
IdContext, IdCustomHTTPServer,
|
||||
{$IF CompilerVersion <= 21.0} //D2010
|
||||
IdHashSHA1,
|
||||
{$else}
|
||||
IdHashSHA, //XE3 etc
|
||||
{$IFEND}
|
||||
IdServerSocketIOHandling, IdServerWebsocketContext,
|
||||
Classes, IdServerBaseHandling, IdIOHandlerWebsocket;
|
||||
|
||||
type
|
||||
TIdServerSocketIOHandling_Ext = class(TIdServerSocketIOHandling)
|
||||
end;
|
||||
|
||||
TIdServerWebsocketHandling = class(TIdServerBaseHandling)
|
||||
protected
|
||||
class procedure DoWSExecute(AThread: TIdContext; aSocketIOHandler: TIdServerSocketIOHandling_Ext);virtual;
|
||||
class procedure HandleWSMessage(AContext: TIdServerWSContext; aType: TWSDataType;
|
||||
aRequestStrm, aResponseStrm: TMemoryStream;
|
||||
aSocketIOHandler: TIdServerSocketIOHandling_Ext);virtual;
|
||||
public
|
||||
class function ProcessServerCommandGet(AThread: TIdServerWSContext;
|
||||
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo): Boolean;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
StrUtils, SysUtils, IdCustomTCPServer, IdCoderMIME;
|
||||
|
||||
{ TIdServerWebsocketHandling }
|
||||
|
||||
class procedure TIdServerWebsocketHandling.DoWSExecute(AThread: TIdContext; aSocketIOHandler: TIdServerSocketIOHandling_Ext);
|
||||
var
|
||||
strmRequest, strmResponse: TMemoryStream;
|
||||
wscode: TWSDataCode;
|
||||
wstype: TWSDataType;
|
||||
context: TIdServerWSContext;
|
||||
begin
|
||||
context := nil;
|
||||
try
|
||||
context := AThread as TIdServerWSContext;
|
||||
//todo: make seperate function + do it after first real write (not header!)
|
||||
if context.IOHandler.BusyUpgrading then
|
||||
begin
|
||||
context.IOHandler.IsWebsocket := True;
|
||||
context.IOHandler.BusyUpgrading := False;
|
||||
end;
|
||||
//initial connect
|
||||
if context.IsSocketIO then
|
||||
begin
|
||||
Assert(aSocketIOHandler <> nil);
|
||||
aSocketIOHandler.WriteConnect(context);
|
||||
end;
|
||||
//AThread.Connection.Socket.UseNagle := False;
|
||||
|
||||
while AThread.Connection.Connected do
|
||||
begin
|
||||
if (AThread.Connection.IOHandler.InputBuffer.Size > 0) or
|
||||
AThread.Connection.IOHandler.Readable(5 * 1000) then //wait 5s, else ping the client(!)
|
||||
begin
|
||||
strmResponse := TMemoryStream.Create;
|
||||
strmRequest := TMemoryStream.Create;
|
||||
try
|
||||
context := AThread as TIdServerWSContext;
|
||||
|
||||
strmRequest.Position := 0;
|
||||
//first is the type: text or bin
|
||||
wscode := TWSDataCode(context.IOHandler.ReadLongWord);
|
||||
//then the length + data = stream
|
||||
context.IOHandler.ReadStream(strmRequest);
|
||||
strmRequest.Position := 0;
|
||||
//ignore ping/pong messages
|
||||
if wscode in [wdcPing, wdcPong] then
|
||||
begin
|
||||
if wscode = wdcPing then
|
||||
context.IOHandler.WriteData(nil, wdcPong);
|
||||
Continue;
|
||||
end;
|
||||
|
||||
if wscode = wdcText then
|
||||
wstype := wdtText
|
||||
else
|
||||
wstype := wdtBinary;
|
||||
|
||||
HandleWSMessage(context, wstype, strmRequest, strmResponse, aSocketIOHandler);
|
||||
|
||||
//write result back (of the same type: text or bin)
|
||||
if strmResponse.Size > 0 then
|
||||
begin
|
||||
if wscode = wdcText then
|
||||
context.IOHandler.Write(strmResponse, wdtText)
|
||||
else
|
||||
context.IOHandler.Write(strmResponse, wdtBinary)
|
||||
end
|
||||
else
|
||||
context.IOHandler.WriteData(nil, wdcPing);
|
||||
finally
|
||||
strmRequest.Free;
|
||||
strmResponse.Free;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
//ping
|
||||
if context.IsSocketIO then
|
||||
begin
|
||||
//context.SocketIOPingSend := True;
|
||||
Assert(aSocketIOHandler <> nil);
|
||||
aSocketIOHandler.WritePing(context);
|
||||
end
|
||||
else
|
||||
context.IOHandler.WriteData(nil, wdcPing);
|
||||
end;
|
||||
|
||||
end;
|
||||
finally
|
||||
if context.IsSocketIO then
|
||||
begin
|
||||
Assert(aSocketIOHandler <> nil);
|
||||
aSocketIOHandler.WriteDisConnect(context);
|
||||
end;
|
||||
|
||||
AThread.Data := nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
class procedure TIdServerWebsocketHandling.HandleWSMessage(AContext: TIdServerWSContext; aType: TWSDataType;
|
||||
aRequestStrm, aResponseStrm: TMemoryStream;
|
||||
aSocketIOHandler: TIdServerSocketIOHandling_Ext);
|
||||
begin
|
||||
if AContext.IsSocketIO then
|
||||
begin
|
||||
aRequestStrm.Position := 0;
|
||||
Assert(aSocketIOHandler <> nil);
|
||||
aSocketIOHandler.ProcessSocketIORequest(AContext, aRequestStrm);
|
||||
end
|
||||
else if Assigned(AContext.OnCustomChannelExecute) then
|
||||
AContext.OnCustomChannelExecute(AContext, aType, aRequestStrm, aResponseStrm);
|
||||
end;
|
||||
|
||||
class function TIdServerWebsocketHandling.ProcessServerCommandGet(
|
||||
AThread: TIdServerWSContext; ARequestInfo: TIdHTTPRequestInfo;
|
||||
AResponseInfo: TIdHTTPResponseInfo): Boolean;
|
||||
var
|
||||
sValue, squid: string;
|
||||
context: TIdServerWSContext;
|
||||
hash: TIdHashSHA1;
|
||||
guid: TGUID;
|
||||
begin
|
||||
(* GET /chat HTTP/1.1
|
||||
Host: server.example.com
|
||||
Upgrade: websocket
|
||||
Connection: Upgrade
|
||||
Sec-WebSocket-Key: dGhlIHNhbXBsZSBub25jZQ==
|
||||
Origin: http://example.com
|
||||
Sec-WebSocket-Protocol: chat, superchat
|
||||
Sec-WebSocket-Version: 13 *)
|
||||
|
||||
(* GET ws://echo.websocket.org/?encoding=text HTTP/1.1
|
||||
Origin: http://websocket.org
|
||||
Cookie: __utma=99as
|
||||
Connection: Upgrade
|
||||
Host: echo.websocket.org
|
||||
Sec-WebSocket-Key: uRovscZjNol/umbTt5uKmw==
|
||||
Upgrade: websocket
|
||||
Sec-WebSocket-Version: 13 *)
|
||||
|
||||
//Connection: Upgrade
|
||||
if not SameText('Upgrade', ARequestInfo.Connection) then
|
||||
begin
|
||||
//initiele ondersteuning voor socket.io
|
||||
if SameText(ARequestInfo.document , '/socket.io/1/') then
|
||||
begin
|
||||
{
|
||||
https://github.com/LearnBoost/socket.io-spec
|
||||
The client will perform an initial HTTP POST request like the following
|
||||
http://example.com/socket.io/1/
|
||||
200: The handshake was successful.
|
||||
The body of the response should contain the session id (sid) given to the client, followed by the heartbeat timeout, the connection closing timeout, and the list of supported transports separated by :
|
||||
The absence of a heartbeat timeout ('') is interpreted as the server and client not expecting heartbeats.
|
||||
For example 4d4f185e96a7b:15:10:websocket,xhr-polling.
|
||||
}
|
||||
AResponseInfo.ResponseNo := 200;
|
||||
AResponseInfo.ResponseText := 'Socket.io connect OK';
|
||||
|
||||
CreateGUID(guid);
|
||||
squid := GUIDToString(guid);
|
||||
AResponseInfo.ContentText := squid +
|
||||
':15:10:websocket,xhr-polling';
|
||||
AResponseInfo.CloseConnection := False;
|
||||
//(AThread.SocketIO as TIdServerSocketIOHandling_Ext).NewConnection(AThread);
|
||||
(AThread.SocketIO as TIdServerSocketIOHandling_Ext).NewConnection(squid, AThread.Binding.PeerIP);
|
||||
|
||||
Result := True; //handled
|
||||
end
|
||||
//'/socket.io/1/xhr-polling/2129478544'
|
||||
else if StartsText('/socket.io/1/xhr-polling/', ARequestInfo.document) then
|
||||
begin
|
||||
AResponseInfo.ContentStream := TMemoryStream.Create;
|
||||
AResponseInfo.CloseConnection := False;
|
||||
|
||||
squid := Copy(ARequestInfo.Document, 1 + Length('/socket.io/1/xhr-polling/'), Length(ARequestInfo.document));
|
||||
if ARequestInfo.CommandType = hcGET then
|
||||
(AThread.SocketIO as TIdServerSocketIOHandling_Ext)
|
||||
.ProcessSocketIO_XHR(squid, ARequestInfo.PostStream, AResponseInfo.ContentStream)
|
||||
else if ARequestInfo.CommandType = hcPOST then
|
||||
(AThread.SocketIO as TIdServerSocketIOHandling_Ext)
|
||||
.ProcessSocketIO_XHR(squid, ARequestInfo.PostStream, nil); //no response expected with POST!
|
||||
Result := True; //handled
|
||||
end
|
||||
else
|
||||
Result := False; //NOT handled
|
||||
end
|
||||
else
|
||||
begin
|
||||
Result := True; //handled
|
||||
context := AThread as TIdServerWSContext;
|
||||
|
||||
//Sec-WebSocket-Key: dGhlIHNhbXBsZSBub25jZQ==
|
||||
sValue := ARequestInfo.RawHeaders.Values['sec-websocket-key'];
|
||||
//"The value of this header field MUST be a nonce consisting of a randomly
|
||||
// selected 16-byte value that has been base64-encoded"
|
||||
if (sValue <> '') then
|
||||
begin
|
||||
if (Length(TIdDecoderMIME.DecodeString(sValue)) = 16) then
|
||||
context.WebSocketKey := sValue
|
||||
else
|
||||
Abort; //invalid length
|
||||
end
|
||||
else
|
||||
//important: key must exists, otherwise stop!
|
||||
Abort;
|
||||
|
||||
(*
|
||||
ws-URI = "ws:" "//" host [ ":" port ] path [ "?" query ]
|
||||
wss-URI = "wss:" "//" host [ ":" port ] path [ "?" query ]
|
||||
2. The method of the request MUST be GET, and the HTTP version MUST be at least 1.1.
|
||||
For example, if the WebSocket URI is "ws://example.com/chat",
|
||||
the first line sent should be "GET /chat HTTP/1.1".
|
||||
3. The "Request-URI" part of the request MUST match the /resource
|
||||
name/ defined in Section 3 (a relative URI) or be an absolute
|
||||
http/https URI that, when parsed, has a /resource name/, /host/,
|
||||
and /port/ that match the corresponding ws/wss URI.
|
||||
*)
|
||||
context.ResourceName := ARequestInfo.Document;
|
||||
if ARequestInfo.UnparsedParams <> '' then
|
||||
context.ResourceName := context.ResourceName + '?' +
|
||||
ARequestInfo.UnparsedParams;
|
||||
//seperate parts
|
||||
context.Path := ARequestInfo.Document;
|
||||
context.Query := ARequestInfo.UnparsedParams;
|
||||
|
||||
//Host: server.example.com
|
||||
context.Host := ARequestInfo.RawHeaders.Values['host'];
|
||||
//Origin: http://example.com
|
||||
context.Origin := ARequestInfo.RawHeaders.Values['origin'];
|
||||
//Cookie: __utma=99as
|
||||
context.Cookie := ARequestInfo.RawHeaders.Values['cookie'];
|
||||
|
||||
//Sec-WebSocket-Version: 13
|
||||
//"The value of this header field MUST be 13"
|
||||
sValue := ARequestInfo.RawHeaders.Values['sec-websocket-version'];
|
||||
context.WebSocketKey := sValue
|
||||
else
|
||||
Abort; //invalid length
|
||||
end
|
||||
else
|
||||
//important: key must exists, otherwise stop!
|
||||
Abort;
|
||||
|
||||
(*
|
||||
ws-URI = "ws:" "//" host [ ":" port ] path [ "?" query ]
|
||||
wss-URI = "wss:" "//" host [ ":" port ] path [ "?" query ]
|
||||
2. The method of the request MUST be GET, and the HTTP version MUST be at least 1.1.
|
||||
For example, if the WebSocket URI is "ws://example.com/chat",
|
||||
the first line sent should be "GET /chat HTTP/1.1".
|
||||
3. The "Request-URI" part of the request MUST match the /resource
|
||||
name/ defined in Section 3 (a relative URI) or be an absolute
|
||||
http/https URI that, when parsed, has a /resource name/, /host/,
|
||||
and /port/ that match the corresponding ws/wss URI.
|
||||
*)
|
||||
context.ResourceName := ARequestInfo.Document;
|
||||
if ARequestInfo.UnparsedParams <> '' then
|
||||
context.ResourceName := context.ResourceName + '?' +
|
||||
ARequestInfo.UnparsedParams;
|
||||
//seperate parts
|
||||
context.Path := ARequestInfo.Document;
|
||||
context.Query := ARequestInfo.UnparsedParams;
|
||||
|
||||
//Host: server.example.com
|
||||
context.Host := ARequestInfo.RawHeaders.Values['host'];
|
||||
//Origin: http://example.com
|
||||
context.Origin := ARequestInfo.RawHeaders.Values['origin'];
|
||||
//Cookie: __utma=99as
|
||||
context.Cookie := ARequestInfo.RawHeaders.Values['cookie'];
|
||||
|
||||
//Sec-WebSocket-Version: 13
|
||||
//"The value of this header field MUST be 13"
|
||||
sValue := ARequestInfo.RawHeaders.Values['sec-websocket-version'];
|
||||
if (sValue <> '') then
|
||||
begin
|
||||
context.WebSocketVersion := StrToIntDef(sValue, 0);
|
||||
if context.WebSocketVersion < 13 then
|
||||
Abort; //must be at least 13
|
||||
end
|
||||
else
|
||||
Abort; //must exist
|
||||
|
||||
context.WebSocketProtocol := ARequestInfo.RawHeaders.Values['sec-websocket-protocol'];
|
||||
if context.WebSocketVersion < 13 then
|
||||
|
||||
Abort; //must be at least 13
|
||||
|
||||
end
|
||||
else
|
||||
Abort; //must exist
|
||||
|
||||
context.WebSocketProtocol := ARequestInfo.RawHeaders.Values['sec-websocket-protocol'];
|
||||
context.WebSocketExtensions := ARequestInfo.RawHeaders.Values['sec-websocket-extensions'];
|
||||
|
||||
//Response
|
||||
(* HTTP/1.1 101 Switching Protocols
|
||||
Upgrade: websocket
|
||||
Connection: Upgrade
|
||||
Upgrade: websocket
|
||||
Connection: Upgrade
|
||||
Sec-WebSocket-Accept: s3pPLMBiTxaQ9kYGzzhZRbK+xOo= *)
|
||||
AResponseInfo.ResponseNo := 101;
|
||||
AResponseInfo.ResponseText := 'Switching Protocols';
|
||||
|
|
@ -287,14 +295,14 @@ begin
|
|||
|
||||
//Sec-WebSocket-Accept: s3pPLMBiTxaQ9kYGzzhZRbK+xOo=
|
||||
sValue := Trim(context.WebSocketKey) + //... "minus any leading and trailing whitespace"
|
||||
'258EAFA5-E914-47DA-95CA-C5AB0DC85B11'; //special GUID
|
||||
hash := TIdHashSHA1.Create;
|
||||
try
|
||||
sValue := TIdEncoderMIME.EncodeBytes( //Base64
|
||||
hash.HashString(sValue) ); //SHA1
|
||||
finally
|
||||
hash.Free;
|
||||
end;
|
||||
'258EAFA5-E914-47DA-95CA-C5AB0DC85B11'; //special GUID
|
||||
hash := TIdHashSHA1.Create;
|
||||
try
|
||||
sValue := TIdEncoderMIME.EncodeBytes( //Base64
|
||||
hash.HashString(sValue) ); //SHA1
|
||||
finally
|
||||
hash.Free;
|
||||
end;
|
||||
AResponseInfo.CustomHeaders.Values['Sec-WebSocket-Accept'] := sValue;
|
||||
|
||||
//send same protocol back?
|
||||
|
|
@ -308,10 +316,10 @@ begin
|
|||
context.IOHandler.InputBuffer.Clear;
|
||||
context.IOHandler.BusyUpgrading := True;
|
||||
AResponseInfo.WriteHeader;
|
||||
|
||||
|
||||
//handle all WS communication in seperate loop
|
||||
DoWSExecute(AThread, (context.SocketIO as TIdServerSocketIOHandling_Ext) );
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
DoWSExecute(AThread, (context.SocketIO as TIdServerSocketIOHandling_Ext) );
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
|
|
@ -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);
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue