error handling and unit test

.gitattributes

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

.gitignore

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

DUnit/NewLibrary_Intf.pas

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

DUnit/NewLibrary_Invk.pas

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

DUnit/NewService_Impl.pas

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

DUnit/UnitTestWebsockets.dpr

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

DUnit/mtTestROWebSockets.pas

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

DUnit/mtTestWebSockets.pas

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

IdHTTPWebsocketClient.pas

@@ -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,
+  IdStackBSDBase, IdGlobal, Windows, StrUtils;
-  mcFinalizationHelper;
 
 //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
+  //if not Assigned(OnTextData) then Exit;
-    FSocketIO.ProcessSocketIORequest(FSocketIOContext as TSocketIOContext, aEvent)
+  //events during dispatch? channel is busy so offload event dispatching to different thread!
-  else
+  TIdWebsocketDispatchThread.Instance.QueueEvent(
-  begin
+    procedure
-    if not Assigned(OnTextData) then Exit;
+    begin
-    //events during dispatch? channel is busy so offload event dispatching to different thread!
+      if FSocketIOCompatible then
-    TIdWebsocketDispatchThread.Instance.QueueEvent(
+        FSocketIO.ProcessSocketIORequest(FSocketIOContext as TSocketIOContext, aEvent)
-      procedure
+      else if Assigned(OnTextData) then
-      begin
+        OnTextData(aEvent);
-        if Assigned(OnTextData) then
+    end);
-          OnTextData(aEvent);
-      end);
-  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
+//  if (iResult <> Id_SOCKET_ERROR) or
-     ( (GStack <> nil) and (GStack.WSGetLastError <> WSAEWOULDBLOCK) )
+//     ( (GStack <> nil) and (GStack.WSGetLastError <> WSAEWOULDBLOCK) )
-  then
+//  then
-    GStack.CheckForSocketError(iResult);
+//    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
+  if (FInstance = nil) then
-     not TFinalizationHelper.ApplicationIsTerminating 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);
+    GlobalNameSpace.BeginWrite;
-    FInstance.Start;
+    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;
 

IdServerIOHandlerWebsocket.pas

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

IdServerSocketIOHandling.pas

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

IdServerWebsocketContext.pas

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

IdServerWebsocketHandling.pas

@@ -1,281 +1,289 @@
-unit IdServerWebsocketHandling;
+unit IdServerWebsocketHandling;
-
+
-interface
+interface
-
+
-uses
+uses
-  IdContext, IdCustomHTTPServer, IdHashSHA1,
+  IdContext, IdCustomHTTPServer,
-  IdServerSocketIOHandling, IdServerWebsocketContext,
+  {$IF CompilerVersion <= 21.0}  //D2010
-  Classes, IdServerBaseHandling, IdIOHandlerWebsocket;
+  IdHashSHA1,
-
+  {$else}
-type
+  IdHashSHA,                     //XE3 etc
-  TIdServerSocketIOHandling_Ext = class(TIdServerSocketIOHandling)
+  {$IFEND}
-  end;
+  IdServerSocketIOHandling, IdServerWebsocketContext,
-
+  Classes, IdServerBaseHandling, IdIOHandlerWebsocket;
-  TIdServerWebsocketHandling = class(TIdServerBaseHandling)
+
-  protected
+type
-    class procedure DoWSExecute(AThread: TIdContext; aSocketIOHandler: TIdServerSocketIOHandling_Ext);virtual;
+  TIdServerSocketIOHandling_Ext = class(TIdServerSocketIOHandling)
-    class procedure HandleWSMessage(AContext: TIdServerWSContext; aType: TWSDataType;
+  end;
-                                    aRequestStrm, aResponseStrm: TMemoryStream;
+
-                                    aSocketIOHandler: TIdServerSocketIOHandling_Ext);virtual;
+  TIdServerWebsocketHandling = class(TIdServerBaseHandling)
-  public
+  protected
-    class function ProcessServerCommandGet(AThread: TIdServerWSContext;
+    class procedure DoWSExecute(AThread: TIdContext; aSocketIOHandler: TIdServerSocketIOHandling_Ext);virtual;
-      ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo): Boolean;
+    class procedure HandleWSMessage(AContext: TIdServerWSContext; aType: TWSDataType;
-  end;
+                                    aRequestStrm, aResponseStrm: TMemoryStream;
-
+                                    aSocketIOHandler: TIdServerSocketIOHandling_Ext);virtual;
-implementation
+  public
-
+    class function ProcessServerCommandGet(AThread: TIdServerWSContext;
-uses
+      ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo): Boolean;
-  StrUtils, SysUtils, IdCustomTCPServer, IdCoderMIME;
+  end;
-
+
-{ TIdServerWebsocketHandling }
+implementation
-
+
-class procedure TIdServerWebsocketHandling.DoWSExecute(AThread: TIdContext; aSocketIOHandler: TIdServerSocketIOHandling_Ext);
+uses
-var
+  StrUtils, SysUtils, IdCustomTCPServer, IdCoderMIME;
-  strmRequest, strmResponse: TMemoryStream;
+
-  wscode: TWSDataCode;
+{ TIdServerWebsocketHandling }
-  wstype: TWSDataType;
+
-  context: TIdServerWSContext;
+class procedure TIdServerWebsocketHandling.DoWSExecute(AThread: TIdContext; aSocketIOHandler: TIdServerSocketIOHandling_Ext);
-begin
+var
-  context   := nil;
+  strmRequest, strmResponse: TMemoryStream;
-  try
+  wscode: TWSDataCode;
-    context := AThread as TIdServerWSContext;
+  wstype: TWSDataType;
-    //todo: make seperate function + do it after first real write (not header!)
+  context: TIdServerWSContext;
-    if context.IOHandler.BusyUpgrading then
+begin
-    begin
+  context   := nil;
-      context.IOHandler.IsWebsocket   := True;
+  try
-      context.IOHandler.BusyUpgrading := False;
+    context := AThread as TIdServerWSContext;
-    end;
+    //todo: make seperate function + do it after first real write (not header!)
-    //initial connect
+    if context.IOHandler.BusyUpgrading then
-    if context.IsSocketIO then
+    begin
-    begin
+      context.IOHandler.IsWebsocket   := True;
-      Assert(aSocketIOHandler <> nil);
+      context.IOHandler.BusyUpgrading := False;
-      aSocketIOHandler.WriteConnect(context);
+    end;
-    end;
+    //initial connect
-    //AThread.Connection.Socket.UseNagle := False;
+    if context.IsSocketIO then
-
+    begin
-    while AThread.Connection.Connected do
+      Assert(aSocketIOHandler <> nil);
-    begin
+      aSocketIOHandler.WriteConnect(context);
-      if (AThread.Connection.IOHandler.InputBuffer.Size > 0) or
+    end;
-         AThread.Connection.IOHandler.Readable(5 * 1000) then     //wait 5s, else ping the client(!)
+    //AThread.Connection.Socket.UseNagle := False;
-      begin
+
-        strmResponse := TMemoryStream.Create;
+    while AThread.Connection.Connected do
-        strmRequest  := TMemoryStream.Create;
+    begin
-        try
+      if (AThread.Connection.IOHandler.InputBuffer.Size > 0) or
-          context := AThread as TIdServerWSContext;
+         AThread.Connection.IOHandler.Readable(5 * 1000) then     //wait 5s, else ping the client(!)
-
+      begin
-          strmRequest.Position := 0;
+        strmResponse := TMemoryStream.Create;
-          //first is the type: text or bin
+        strmRequest  := TMemoryStream.Create;
-          wscode := TWSDataCode(context.IOHandler.ReadLongWord);
+        try
-          //then the length + data = stream
+          context := AThread as TIdServerWSContext;
-          context.IOHandler.ReadStream(strmRequest);
+
-          strmRequest.Position := 0;
+          strmRequest.Position := 0;
-          //ignore ping/pong messages
+          //first is the type: text or bin
-          if wscode in [wdcPing, wdcPong] then
+          wscode := TWSDataCode(context.IOHandler.ReadLongWord);
-          begin
+          //then the length + data = stream
-            if wscode = wdcPing then
+          context.IOHandler.ReadStream(strmRequest);
-              context.IOHandler.WriteData(nil, wdcPong);
+          strmRequest.Position := 0;
-            Continue;
+          //ignore ping/pong messages
-          end;
+          if wscode in [wdcPing, wdcPong] then
-
+          begin
-          if wscode = wdcText then
+            if wscode = wdcPing then
-            wstype := wdtText
+              context.IOHandler.WriteData(nil, wdcPong);
-          else
+            Continue;
-            wstype := wdtBinary;
+          end;
-
+
-          HandleWSMessage(context, wstype, strmRequest, strmResponse, aSocketIOHandler);
+          if wscode = wdcText then
-
+            wstype := wdtText
-          //write result back (of the same type: text or bin)
+          else
-          if strmResponse.Size > 0 then
+            wstype := wdtBinary;
-          begin
+
-            if wscode = wdcText then
+          HandleWSMessage(context, wstype, strmRequest, strmResponse, aSocketIOHandler);
-              context.IOHandler.Write(strmResponse, wdtText)
+
-            else
+          //write result back (of the same type: text or bin)
-              context.IOHandler.Write(strmResponse, wdtBinary)
+          if strmResponse.Size > 0 then
-          end
+          begin
-          else
+            if wscode = wdcText then
-            context.IOHandler.WriteData(nil, wdcPing);
+              context.IOHandler.Write(strmResponse, wdtText)
-        finally
+            else
-          strmRequest.Free;
+              context.IOHandler.Write(strmResponse, wdtBinary)
-          strmResponse.Free;
+          end
-        end;
+          else
-      end
+            context.IOHandler.WriteData(nil, wdcPing);
-      else
+        finally
-      begin
+          strmRequest.Free;
-        //ping
+          strmResponse.Free;
-        if context.IsSocketIO then
+        end;
-        begin
+      end
-          //context.SocketIOPingSend := True;
+      else
-          Assert(aSocketIOHandler <> nil);
+      begin
-          aSocketIOHandler.WritePing(context);
+        //ping
-        end
+        if context.IsSocketIO then
-        else
+        begin
-          context.IOHandler.WriteData(nil, wdcPing);
+          //context.SocketIOPingSend := True;
-      end;
+          Assert(aSocketIOHandler <> nil);
-
+          aSocketIOHandler.WritePing(context);
-    end;
+        end
-  finally
+        else
-    if context.IsSocketIO then
+          context.IOHandler.WriteData(nil, wdcPing);
-    begin
+      end;
-      Assert(aSocketIOHandler <> nil);
+
-      aSocketIOHandler.WriteDisConnect(context);
+    end;
-    end;
+  finally
-
+    if context.IsSocketIO then
-    AThread.Data := nil;
+    begin
-  end;
+      Assert(aSocketIOHandler <> nil);
-end;
+      aSocketIOHandler.WriteDisConnect(context);
-
+    end;
-class procedure TIdServerWebsocketHandling.HandleWSMessage(AContext: TIdServerWSContext; aType: TWSDataType;
+
-  aRequestStrm, aResponseStrm: TMemoryStream;
+    AThread.Data := nil;
-  aSocketIOHandler: TIdServerSocketIOHandling_Ext);
+  end;
-begin
+end;
-  if AContext.IsSocketIO then
+
-  begin
+class procedure TIdServerWebsocketHandling.HandleWSMessage(AContext: TIdServerWSContext; aType: TWSDataType;
-    aRequestStrm.Position := 0;
+  aRequestStrm, aResponseStrm: TMemoryStream;
-    Assert(aSocketIOHandler <> nil);
+  aSocketIOHandler: TIdServerSocketIOHandling_Ext);
-    aSocketIOHandler.ProcessSocketIORequest(AContext, aRequestStrm);
+begin
-  end
+  if AContext.IsSocketIO then
-  else if Assigned(AContext.OnCustomChannelExecute) then
+  begin
-    AContext.OnCustomChannelExecute(AContext, aType, aRequestStrm, aResponseStrm);
+    aRequestStrm.Position := 0;
-end;
+    Assert(aSocketIOHandler <> nil);
-
+    aSocketIOHandler.ProcessSocketIORequest(AContext, aRequestStrm);
-class function TIdServerWebsocketHandling.ProcessServerCommandGet(
+  end
-  AThread: TIdServerWSContext; ARequestInfo: TIdHTTPRequestInfo;
+  else if Assigned(AContext.OnCustomChannelExecute) then
-  AResponseInfo: TIdHTTPResponseInfo): Boolean;
+    AContext.OnCustomChannelExecute(AContext, aType, aRequestStrm, aResponseStrm);
-var
+end;
-  sValue, squid: string;
+
-  context: TIdServerWSContext;
+class function TIdServerWebsocketHandling.ProcessServerCommandGet(
-  hash: TIdHashSHA1;
+  AThread: TIdServerWSContext; ARequestInfo: TIdHTTPRequestInfo;
-  guid: TGUID;
+  AResponseInfo: TIdHTTPResponseInfo): Boolean;
-begin
+var
-  (* GET /chat HTTP/1.1
+  sValue, squid: string;
-     Host: server.example.com
+  context: TIdServerWSContext;
-     Upgrade: websocket
+  hash: TIdHashSHA1;
-     Connection: Upgrade
+  guid: TGUID;
-     Sec-WebSocket-Key: dGhlIHNhbXBsZSBub25jZQ==
+begin
-     Origin: http://example.com
+  (* GET /chat HTTP/1.1
-     Sec-WebSocket-Protocol: chat, superchat
+     Host: server.example.com
-     Sec-WebSocket-Version: 13 *)
+     Upgrade: websocket
-
+     Connection: Upgrade
-  (* GET ws://echo.websocket.org/?encoding=text HTTP/1.1
+     Sec-WebSocket-Key: dGhlIHNhbXBsZSBub25jZQ==
-     Origin: http://websocket.org
+     Origin: http://example.com
-     Cookie: __utma=99as
+     Sec-WebSocket-Protocol: chat, superchat
-     Connection: Upgrade
+     Sec-WebSocket-Version: 13 *)
-     Host: echo.websocket.org
+
-     Sec-WebSocket-Key: uRovscZjNol/umbTt5uKmw==
+  (* GET ws://echo.websocket.org/?encoding=text HTTP/1.1
-     Upgrade: websocket
+     Origin: http://websocket.org
-     Sec-WebSocket-Version: 13 *)
+     Cookie: __utma=99as
-
+     Connection: Upgrade
-  //Connection: Upgrade
+     Host: echo.websocket.org
-  if not SameText('Upgrade', ARequestInfo.Connection) then
+     Sec-WebSocket-Key: uRovscZjNol/umbTt5uKmw==
-  begin
+     Upgrade: websocket
-    //initiele ondersteuning voor socket.io
+     Sec-WebSocket-Version: 13 *)
-    if SameText(ARequestInfo.document , '/socket.io/1/') then
+
-    begin
+  //Connection: Upgrade
-      {
+  if not SameText('Upgrade', ARequestInfo.Connection) then
-      https://github.com/LearnBoost/socket.io-spec
+  begin
-      The client will perform an initial HTTP POST request like the following
+    //initiele ondersteuning voor socket.io
-      http://example.com/socket.io/1/
+    if SameText(ARequestInfo.document , '/socket.io/1/') then
-      200: The handshake was successful.
+    begin
-      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.
+      https://github.com/LearnBoost/socket.io-spec
-      For example 4d4f185e96a7b:15:10:websocket,xhr-polling.
+      The client will perform an initial HTTP POST request like the following
-      }
+      http://example.com/socket.io/1/
-      AResponseInfo.ResponseNo   := 200;
+      200: The handshake was successful.
-      AResponseInfo.ResponseText := 'Socket.io connect OK';
+      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.
-      CreateGUID(guid);
+      For example 4d4f185e96a7b:15:10:websocket,xhr-polling.
-      squid := GUIDToString(guid);
+      }
-      AResponseInfo.ContentText  := squid +
+      AResponseInfo.ResponseNo   := 200;
-                                    ':15:10:websocket,xhr-polling';
+      AResponseInfo.ResponseText := 'Socket.io connect OK';
-      AResponseInfo.CloseConnection := False;
+
-      //(AThread.SocketIO as TIdServerSocketIOHandling_Ext).NewConnection(AThread);
+      CreateGUID(guid);
-      (AThread.SocketIO as TIdServerSocketIOHandling_Ext).NewConnection(squid, AThread.Binding.PeerIP);
+      squid := GUIDToString(guid);
-
+      AResponseInfo.ContentText  := squid +
-      Result := True;  //handled
+                                    ':15:10:websocket,xhr-polling';
-    end
+      AResponseInfo.CloseConnection := False;
-    //'/socket.io/1/xhr-polling/2129478544'
+      //(AThread.SocketIO as TIdServerSocketIOHandling_Ext).NewConnection(AThread);
-    else if StartsText('/socket.io/1/xhr-polling/', ARequestInfo.document) then
+      (AThread.SocketIO as TIdServerSocketIOHandling_Ext).NewConnection(squid, AThread.Binding.PeerIP);
-    begin
+
-      AResponseInfo.ContentStream   := TMemoryStream.Create;
+      Result := True;  //handled
-      AResponseInfo.CloseConnection := False;
+    end
-
+    //'/socket.io/1/xhr-polling/2129478544'
-      squid := Copy(ARequestInfo.Document, 1 + Length('/socket.io/1/xhr-polling/'), Length(ARequestInfo.document));
+    else if StartsText('/socket.io/1/xhr-polling/', ARequestInfo.document) then
-      if ARequestInfo.CommandType = hcGET then
+    begin
-        (AThread.SocketIO as TIdServerSocketIOHandling_Ext)
+      AResponseInfo.ContentStream   := TMemoryStream.Create;
-          .ProcessSocketIO_XHR(squid, ARequestInfo.PostStream, AResponseInfo.ContentStream)
+      AResponseInfo.CloseConnection := False;
-      else if ARequestInfo.CommandType = hcPOST then
+
-        (AThread.SocketIO as TIdServerSocketIOHandling_Ext)
+      squid := Copy(ARequestInfo.Document, 1 + Length('/socket.io/1/xhr-polling/'), Length(ARequestInfo.document));
-          .ProcessSocketIO_XHR(squid, ARequestInfo.PostStream, nil);   //no response expected with POST!
+      if ARequestInfo.CommandType = hcGET then
-      Result := True;  //handled
+        (AThread.SocketIO as TIdServerSocketIOHandling_Ext)
-    end
+          .ProcessSocketIO_XHR(squid, ARequestInfo.PostStream, AResponseInfo.ContentStream)
-    else
+      else if ARequestInfo.CommandType = hcPOST then
-      Result := False;  //NOT handled
+        (AThread.SocketIO as TIdServerSocketIOHandling_Ext)
-  end
+          .ProcessSocketIO_XHR(squid, ARequestInfo.PostStream, nil);   //no response expected with POST!
-  else
+      Result := True;  //handled
-  begin
+    end
-    Result  := True;  //handled
+    else
-    context := AThread as TIdServerWSContext;
+      Result := False;  //NOT handled
-
+  end
-    //Sec-WebSocket-Key: dGhlIHNhbXBsZSBub25jZQ==
+  else
-    sValue := ARequestInfo.RawHeaders.Values['sec-websocket-key'];
+  begin
-    //"The value of this header field MUST be a nonce consisting of a randomly
+    Result  := True;  //handled
-    // selected 16-byte value that has been base64-encoded"
+    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
+        context.WebSocketKey := sValue
-      else
+      else
-        Abort; //invalid length
+        Abort; //invalid length
-    end
+    end
-    else
+    else
-      //important: key must exists, otherwise stop!
+      //important: key must exists, otherwise stop!
-      Abort;
+      Abort;
-
+
-    (*
+    (*
-     ws-URI = "ws:" "//" host [ ":" port ] path [ "?" query ]
+     ws-URI = "ws:" "//" host [ ":" port ] path [ "?" query ]
-     wss-URI = "wss:" "//" 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.
+     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",
+          For example, if the WebSocket URI is "ws://example.com/chat",
-          the first line sent should be "GET /chat HTTP/1.1".
+          the first line sent should be "GET /chat HTTP/1.1".
-     3.   The "Request-URI" part of the request MUST match the /resource
+     3.   The "Request-URI" part of the request MUST match the /resource
-          name/ defined in Section 3 (a relative URI) or be an absolute
+          name/ defined in Section 3 (a relative URI) or be an absolute
-          http/https URI that, when parsed, has a /resource name/, /host/,
+          http/https URI that, when parsed, has a /resource name/, /host/,
-          and /port/ that match the corresponding ws/wss URI.
+          and /port/ that match the corresponding ws/wss URI.
-    *)
+    *)
-    context.ResourceName := ARequestInfo.Document;
+    context.ResourceName := ARequestInfo.Document;
-    if ARequestInfo.UnparsedParams <> '' then
+    if ARequestInfo.UnparsedParams <> '' then
-      context.ResourceName := context.ResourceName + '?' +
+      context.ResourceName := context.ResourceName + '?' +
-                              ARequestInfo.UnparsedParams;
+                              ARequestInfo.UnparsedParams;
-    //seperate parts
+    //seperate parts
-    context.Path         := ARequestInfo.Document;
+    context.Path         := ARequestInfo.Document;
-    context.Query        := ARequestInfo.UnparsedParams;
+    context.Query        := ARequestInfo.UnparsedParams;
-
+
-    //Host: server.example.com
+    //Host: server.example.com
-    context.Host   := ARequestInfo.RawHeaders.Values['host'];
+    context.Host   := ARequestInfo.RawHeaders.Values['host'];
-    //Origin: http://example.com
+    //Origin: http://example.com
-    context.Origin := ARequestInfo.RawHeaders.Values['origin'];
+    context.Origin := ARequestInfo.RawHeaders.Values['origin'];
-    //Cookie: __utma=99as
+    //Cookie: __utma=99as
-    context.Cookie := ARequestInfo.RawHeaders.Values['cookie'];
+    context.Cookie := ARequestInfo.RawHeaders.Values['cookie'];
-
+
-    //Sec-WebSocket-Version: 13
+    //Sec-WebSocket-Version: 13
-    //"The value of this header field MUST be 13"
+    //"The value of this header field MUST be 13"
-    sValue := ARequestInfo.RawHeaders.Values['sec-websocket-version'];
+    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
+       Upgrade: websocket
-       Connection: Upgrade
+       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
+              '258EAFA5-E914-47DA-95CA-C5AB0DC85B11';        //special GUID
-    hash := TIdHashSHA1.Create;
+    hash := TIdHashSHA1.Create;
-    try
+    try
-      sValue := TIdEncoderMIME.EncodeBytes(                   //Base64
+      sValue := TIdEncoderMIME.EncodeBytes(                   //Base64
-                     hash.HashString(sValue) );               //SHA1
+                     hash.HashString(sValue) );               //SHA1
-    finally
+    finally
-      hash.Free;
+      hash.Free;
-    end;
+    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) );
+    DoWSExecute(AThread, (context.SocketIO as TIdServerSocketIOHandling_Ext) );
-  end;
+  end;
-end;
+end;
-
+
-end.
+end.

IdSocketIOHandling.pas

@@ -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 EmitEvent(const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);
-    procedure Send(const aData: string; 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);
+    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 Send(const aData: string; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);
-    procedure SendJSON(const aJSON: ISuperObject; const aCallback: TSocketIOMsgJSON = 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 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);
+    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);
+    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);
+    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 Send(const aMessage: string; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);
-    procedure Emit(const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = 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;
 

uROIndyHTTPWebsocketChannel.pas

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