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

* Add defines for supporting SSL and HTTPBridge and removing SUPEROBJECT dependency

Browse source 
Defines are defined in wsdefines.pas
Removing SUPEROBJECT allow to release under MPL license (which i expect)
Also fix
* bug : framing encoding when sending a frame in multiple parts (fin=false)
* bug : TIdIOHandlerWebsocket TIdIOHandlerWebsocket.ReadFrame _WaitByte ; may hang
Other changes
* Refactoring of TIdServerWebsocketHandling.ProcessServerCommandGet for inheritance
* Add event (TIdServerWSContext) to accept or refuse upgrade (allow to check session cookie)
* Change TWebsocketChannelRequest var aType:TWSDataType to allow receiving in a mode and answering in an other

To use OpenSSL you need a modification in IdSSLOpenSSL to let overwrite TIdSSLIOHandlerSocketOpenSSL class
This commit is contained in:
sage-syfre 2016-10-28 09:20:11 +02:00
parent 8e7f63aeb6
commit cdffdd25e1
10 changed files with 457 additions and 180 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
DUnit/UnitTestWebsockets.dpr
View file

@ -14,7 +14,7 @@ program UnitTestWebsockets;
{$APPTYPE CONSOLE} {$APPTYPE CONSOLE}
{$ENDIF} {$ENDIF}
{$IFNDEF USE_JEDI_JCL} {$MESSAGE ERROR 'Must define "USE_JEDI_JCL" for location info of errors'} {$ENDIF} //{$IFNDEF USE_JEDI_JCL} {$MESSAGE ERROR 'Must define "USE_JEDI_JCL" for location info of errors'} {$ENDIF}
{$R *.RES} {$R *.RES}

14
DUnit/mtTestWebSockets.pas
View file

@ -156,7 +156,7 @@ begin
//* client to server */ //* client to server */
received := ''; received := '';
IndyHTTPWebsocketServer1.SocketIO.OnEvent('TEST_EVENT', IndyHTTPWebsocketServer1.SocketIO.OnEvent('TEST_EVENT',
procedure(const ASocket: ISocketIOContext; const aArgument: TSuperArray; const aCallbackObj: TSocketIOCallbackObj) procedure(const ASocket: ISocketIOContext; const aArgument: TSuperArray; const aCallbackObj: ISocketIOCallback)
begin begin
received := aArgument.ToJson; received := aArgument.ToJson;
end); end);
@ -180,7 +180,7 @@ begin
//* server to client */ //* server to client */
received := ''; received := '';
IndyHTTPWebsocketClient1.SocketIO.OnEvent('TEST_EVENT', IndyHTTPWebsocketClient1.SocketIO.OnEvent('TEST_EVENT',
procedure(const ASocket: ISocketIOContext; const aArgument: TSuperArray; const aCallbackObj: TSocketIOCallbackObj) procedure(const ASocket: ISocketIOContext; const aArgument: TSuperArray; const aCallbackObj: ISocketIOCallback)
begin begin
received := aArgument.ToJson; received := aArgument.ToJson;
end); end);
@ -205,12 +205,12 @@ begin
//* client to server */ //* client to server */
FLastSocketIOMsg := ''; FLastSocketIOMsg := '';
IndyHTTPWebsocketServer1.SocketIO.OnSocketIOMsg := IndyHTTPWebsocketServer1.SocketIO.OnSocketIOMsg :=
procedure(const ASocket: ISocketIOContext; const aText: string; const aCallback: TSocketIOCallbackObj) procedure(const ASocket: ISocketIOContext; const aText: string; const aCallback: ISocketIOCallback)
begin begin
Abort; Abort;
end; end;
IndyHTTPWebsocketClient1.SocketIO.Send('test message', IndyHTTPWebsocketClient1.SocketIO.Send('test message',
procedure(const ASocket: ISocketIOContext; const aJSON: ISuperObject; const aCallback: TSocketIOCallbackObj) procedure(const ASocket: ISocketIOContext; const aJSON: ISuperObject; const aCallback: ISocketIOCallback)
begin begin
FLastSocketIOMsg := aJSON.AsString; FLastSocketIOMsg := aJSON.AsString;
end); end);
@ -223,7 +223,7 @@ begin
FLastSocketIOMsg := ''; FLastSocketIOMsg := '';
IndyHTTPWebsocketClient1.SocketIO.Send('test message', IndyHTTPWebsocketClient1.SocketIO.Send('test message',
procedure(const ASocket: ISocketIOContext; const aJSON: ISuperObject; const aCallback: TSocketIOCallbackObj) procedure(const ASocket: ISocketIOContext; const aJSON: ISuperObject; const aCallback: ISocketIOCallback)
begin begin
Assert(False, 'should go to error handling callback'); Assert(False, 'should go to error handling callback');
FLastSocketIOMsg := 'error'; FLastSocketIOMsg := 'error';
@ -252,7 +252,7 @@ begin
//* client to server */ //* client to server */
FLastSocketIOMsg := ''; FLastSocketIOMsg := '';
IndyHTTPWebsocketServer1.SocketIO.OnSocketIOMsg := IndyHTTPWebsocketServer1.SocketIO.OnSocketIOMsg :=
procedure(const ASocket: ISocketIOContext; const aText: string; const aCallback: TSocketIOCallbackObj) procedure(const ASocket: ISocketIOContext; const aText: string; const aCallback: ISocketIOCallback)
begin begin
FLastSocketIOMsg := aText; FLastSocketIOMsg := aText;
end; end;
@ -267,7 +267,7 @@ begin
//* server to client */ //* server to client */
FLastSocketIOMsg := ''; FLastSocketIOMsg := '';
IndyHTTPWebsocketClient1.SocketIO.OnSocketIOMsg := IndyHTTPWebsocketClient1.SocketIO.OnSocketIOMsg :=
procedure(const ASocket: ISocketIOContext; const aText: string; const aCallback: TSocketIOCallbackObj) procedure(const ASocket: ISocketIOContext; const aText: string; const aCallback: ISocketIOCallback)
begin begin
FLastSocketIOMsg := aText; FLastSocketIOMsg := aText;
end; end;

16
IdHTTPWebsocketClient.pas
View file

@ -1,23 +1,13 @@
unit IdHTTPWebsocketClient; unit IdHTTPWebsocketClient;
interface interface
{$I wsdefines.pas}
uses uses
Classes, Classes,
IdHTTP, IdHTTP,
{$IF CompilerVersion <= 21.0} //D2010
IdHashSHA1,
{$else}
Types, Types,
IdHashSHA, //XE3 etc IdHashSHA, //XE3 etc
{$IFEND}
IdIOHandler, IdIOHandler,
IdIOHandlerWebsocket, IdIOHandlerWebsocket,
{$ifdef FMX}
FMX.Types,
{$ELSE}
ExtCtrls,
{$ENDIF}
IdWinsock2, Generics.Collections, SyncObjs, IdWinsock2, Generics.Collections, SyncObjs,
IdSocketIOHandling; IdSocketIOHandling;
@ -557,7 +547,11 @@ begin
begin begin
Request.Clear; Request.Clear;
Request.Connection := 'keep-alive'; Request.Connection := 'keep-alive';
{$IFDEF WEBSOCKETSSL}
sURL := Format('https://%s:%d/socket.io/1/', [Host, Port]);
{$ELSE}
sURL := Format('http://%s:%d/socket.io/1/', [Host, Port]); sURL := Format('http://%s:%d/socket.io/1/', [Host, Port]);
{$ENDIF}
strmResponse.Clear; strmResponse.Clear;
ReadTimeout := 5 * 1000; ReadTimeout := 5 * 1000;

133
IdIOHandlerWebsocket.pas
View file

@ -1,17 +1,19 @@
unit IdIOHandlerWebsocket; unit IdIOHandlerWebsocket;
{.$DEFINE DEBUG_WS} {.$DEFINE DEBUG_WS}
//The WebSocket Protocol, RFC 6455 //The WebSocket Protocol, RFC 6455
//http://datatracker.ietf.org/doc/rfc6455/?include_text=1 //http://datatracker.ietf.org/doc/rfc6455/?include_text=1
interface interface
{$I wsdefines.pas}
uses uses
Classes, SysUtils, Classes, SysUtils , SyncObjs , Generics.Collections
IdIOHandlerStack, IdGlobal, IdException, IdBuffer, , IdIOHandlerStack
SyncObjs, , IdGlobal
Generics.Collections; , IdException
, IdBuffer
{$IFDEF WEBSOCKETSSL}
, IdSSLOpenSSL
{$ENDIF}
;
type type
TWSDataType = (wdtText, wdtBinary); TWSDataType = (wdtText, wdtBinary);
@ -26,7 +28,19 @@ type
TIdTextEncoding = IIdTextEncoding; TIdTextEncoding = IIdTextEncoding;
{$ifend} {$ifend}
TIOWSPayloadInfo = Record
aPayloadLength: Cardinal;
aDataCode: TWSDataCode;
procedure Initialize(iTextMode:Boolean; iPayloadLength:Cardinal);
function DecLength(value:Cardinal):boolean;
procedure Clear;
end;
{$IFDEF WEBSOCKETSSL}
TIdIOHandlerWebsocket = class(TIdSSLIOHandlerSocketOpenSSL)
{$ELSE}
TIdIOHandlerWebsocket = class(TIdIOHandlerStack) TIdIOHandlerWebsocket = class(TIdIOHandlerStack)
{$ENDIF}
private private
FIsServerSide: Boolean; FIsServerSide: Boolean;
FBusyUpgrading: Boolean; FBusyUpgrading: Boolean;
@ -44,9 +58,9 @@ type
procedure SetIsWebsocket(const Value: Boolean); procedure SetIsWebsocket(const Value: Boolean);
protected protected
FMessageStream: TMemoryStream; FMessageStream: TMemoryStream;
FWriteTextToTarget: Boolean;
FCloseCodeSend: Boolean; FCloseCodeSend: Boolean;
FPendingWriteCount: Integer; FPendingWriteCount: Integer;
fPayloadInfo: TIOWSPayloadInfo;
function InternalReadDataFromSource(var VBuffer: TIdBytes; ARaiseExceptionOnTimeout: Boolean): Integer; function InternalReadDataFromSource(var VBuffer: TIdBytes; ARaiseExceptionOnTimeout: Boolean): Integer;
function ReadDataFromSource(var VBuffer: TIdBytes): Integer; override; function ReadDataFromSource(var VBuffer: TIdBytes): Integer; override;
@ -60,6 +74,7 @@ type
{$else} {$else}
function UTF8Encoding: TEncoding; function UTF8Encoding: TEncoding;
{$ifend} {$ifend}
procedure InitComponent; override;
public public
function WriteData(aData: TIdBytes; aType: TWSDataCode; function WriteData(aData: TIdBytes; aType: TWSDataCode;
aFIN: boolean = true; aRSV1: boolean = false; aRSV2: boolean = false; aRSV3: boolean = false): integer; aFIN: boolean = true; aRSV1: boolean = false; aRSV2: boolean = false; aRSV3: boolean = false): integer;
@ -68,8 +83,6 @@ type
property IsServerSide : Boolean read FIsServerSide write FIsServerSide; property IsServerSide : Boolean read FIsServerSide write FIsServerSide;
property ClientExtensionBits : TWSExtensionBits read FExtensionBits write FExtensionBits; property ClientExtensionBits : TWSExtensionBits read FExtensionBits write FExtensionBits;
public public
class constructor Create;
procedure AfterConstruction;override;
destructor Destroy; override; destructor Destroy; override;
procedure Lock; procedure Lock;
@ -229,15 +242,45 @@ begin
end; end;
end; end;
{ TIOWSPayloadInfo }
procedure TIOWSPayloadInfo.Initialize(iTextMode:Boolean; iPayloadLength:Cardinal);
begin
aPayloadLength := iPayloadLength;
if iTextMode
then aDataCode := wdcText
else aDataCode := wdcBinary;
end;
procedure TIOWSPayloadInfo.Clear;
begin
aPayloadLength := 0;
aDataCode := wdcBinary;
end;
function TIOWSPayloadInfo.DecLength(value:Cardinal):boolean;
begin
if aPayloadLength >= value then
begin
aPayloadLength := aPayloadLength - value;
end
else aPayloadLength := 0;
aDataCode := wdcContinuation;
Result := aPayloadLength = 0;
end;
{ TIdIOHandlerStack_Websocket } { TIdIOHandlerStack_Websocket }
procedure TIdIOHandlerWebsocket.AfterConstruction; procedure TIdIOHandlerWebsocket.InitComponent;
begin begin
inherited; inherited ;
FMessageStream := TMemoryStream.Create; FMessageStream := TMemoryStream.Create;
FWSInputBuffer := TIdBuffer.Create; FWSInputBuffer := TIdBuffer.Create;
FLock := TCriticalSection.Create; FLock := TCriticalSection.Create;
FSelectLock := TCriticalSection.Create; FSelectLock := TCriticalSection.Create;
{$IFDEF WEBSOCKETSSL}
//SendBufferSize := 15 * 1024;
{$ENDIF}
end; end;
procedure TIdIOHandlerWebsocket.Clear; procedure TIdIOHandlerWebsocket.Clear;
@ -253,7 +296,7 @@ begin
FCloseCode := 0; FCloseCode := 0;
FLastActivityTime := 0; FLastActivityTime := 0;
FLastPingTime := 0; FLastPingTime := 0;
FWriteTextToTarget := False; fPayloadInfo.Clear;
FCloseCodeSend := False; FCloseCodeSend := False;
FPendingWriteCount := 0; FPendingWriteCount := 0;
end; end;
@ -340,11 +383,6 @@ begin
end; end;
end; end;
class constructor TIdIOHandlerWebsocket.Create;
begin
//UseSingleWriteThread := True;
end;
destructor TIdIOHandlerWebsocket.Destroy; destructor TIdIOHandlerWebsocket.Destroy;
begin begin
while FPendingWriteCount > 0 do while FPendingWriteCount > 0 do
@ -400,8 +438,7 @@ begin
SetLength(VBuffer, Result); SetLength(VBuffer, Result);
end; end;
procedure TIdIOHandlerWebsocket.WriteLn(const AOut: string; procedure TIdIOHandlerWebsocket.WriteLn(const AOut:string; AEncoding: TIdTextEncoding);
AEncoding: TIdTextEncoding);
begin begin
if UseSingleWriteThread and IsWebsocket and if UseSingleWriteThread and IsWebsocket and
(GetCurrentThreadId <> TIdWebsocketWriteThread.Instance.ThreadID) then (GetCurrentThreadId <> TIdWebsocketWriteThread.Instance.ThreadID) then
@ -418,10 +455,10 @@ begin
begin begin
Lock; Lock;
try try
FWriteTextToTarget := True; fPayloadInfo.Initialize(True,0);
inherited WriteLn(AOut, UTF8Encoding); //must be UTF8! inherited WriteLn(AOut, UTF8Encoding); //must be UTF8!
finally finally
FWriteTextToTarget := False; fPayloadInfo.Clear;
Unlock; Unlock;
end; end;
end; end;
@ -445,10 +482,10 @@ begin
begin begin
Lock; Lock;
try try
FWriteTextToTarget := True; fPayloadInfo.Initialize(True,0);
inherited WriteLnRFC(AOut, UTF8Encoding); //must be UTF8! inherited WriteLnRFC(AOut, UTF8Encoding); //must be UTF8!
finally finally
FWriteTextToTarget := False; fPayloadInfo.Clear;
Unlock; Unlock;
end; end;
end; end;
@ -472,10 +509,10 @@ begin
begin begin
Lock; Lock;
try try
FWriteTextToTarget := True; fPayloadInfo.Initialize(True,0);
inherited Write(AOut, UTF8Encoding); //must be UTF8! inherited Write(AOut, UTF8Encoding); //must be UTF8!
finally finally
FWriteTextToTarget := False; fPayloadInfo.Clear;
Unlock; Unlock;
end; end;
end; end;
@ -499,10 +536,10 @@ begin
begin begin
Lock; Lock;
try try
FWriteTextToTarget := True; fPayloadInfo.Initialize(True,0);
inherited Write(AValue, AWriteLinesCount, UTF8Encoding); //must be UTF8! inherited Write(AValue, AWriteLinesCount, UTF8Encoding); //must be UTF8!
finally finally
FWriteTextToTarget := False; fPayloadInfo.Clear;
Unlock; Unlock;
end; end;
end; end;
@ -526,10 +563,10 @@ begin
begin begin
Lock; Lock;
try try
FWriteTextToTarget := (aType = wdtText); fPayloadInfo.Initialize((aType = wdtText),AStream.Size);
inherited Write(AStream); inherited Write(AStream);
finally finally
FWriteTextToTarget := False; fPayloadInfo.Clear;
Unlock; Unlock;
end; end;
end; end;
@ -554,10 +591,8 @@ begin
inherited WriteBufferFlush(AByteCount); inherited WriteBufferFlush(AByteCount);
end; end;
function TIdIOHandlerWebsocket.WriteDataToTarget(const ABuffer: TIdBytes; function TIdIOHandlerWebsocket.WriteDataToTarget(const ABuffer: TIdBytes; const AOffset, ALength: Integer): Integer;
const AOffset, ALength: Integer): Integer; var data: TIdBytes; DataCode:TWSDataCode; fin:boolean;
var
data: TIdBytes;
begin begin
if UseSingleWriteThread and IsWebsocket and (GetCurrentThreadId <> TIdWebsocketWriteThread.Instance.ThreadID) then if UseSingleWriteThread and IsWebsocket and (GetCurrentThreadId <> TIdWebsocketWriteThread.Instance.ThreadID) then
Assert(False, 'Write done in different thread than TIdWebsocketWriteThread!'); Assert(False, 'Write done in different thread than TIdWebsocketWriteThread!');
@ -584,12 +619,9 @@ begin
{$ENDIF} {$ENDIF}
try try
if FWriteTextToTarget then DataCode := fPayloadInfo.aDataCode;
Result := WriteData(data, wdcText, True{send all at once}, fin := fPayloadInfo.DecLength(ALength);
webBit1 in ClientExtensionBits, webBit2 in ClientExtensionBits, webBit3 in ClientExtensionBits) Result := WriteData(data, DataCode, fin,webBit1 in ClientExtensionBits, webBit2 in ClientExtensionBits, webBit3 in ClientExtensionBits);
else
Result := WriteData(data, wdcBinary, True{send all at once},
webBit1 in ClientExtensionBits, webBit2 in ClientExtensionBits, webBit3 in ClientExtensionBits);
except except
FClosedGracefully := True; FClosedGracefully := True;
Result := -1; Result := -1;
@ -853,7 +885,7 @@ var
temp: TIdBytes; temp: TIdBytes;
begin begin
//if HasData then Exit(True); //if HasData then Exit(True);
if (FWSInputBuffer.Size > 0) then Exit(True); if (FWSInputBuffer.Size > iInputPos) then Exit(True);
Result := InternalReadDataFromSource(temp, ARaiseExceptionOnTimeout) > 0; Result := InternalReadDataFromSource(temp, ARaiseExceptionOnTimeout) > 0;
if Result then if Result then
@ -1019,8 +1051,7 @@ begin
{$ENDIF} {$ENDIF}
end; end;
function TIdIOHandlerWebsocket.WriteData(aData: TIdBytes; function TIdIOHandlerWebsocket.WriteData(aData:TIdBytes; aType:TWSDataCode; aFIN,aRSV1,aRSV2,aRSV3:boolean): integer;
aType: TWSDataCode; aFIN, aRSV1, aRSV2, aRSV3: boolean): integer;
var var
iByte: Byte; iByte: Byte;
i, ioffset: NativeInt; i, ioffset: NativeInt;
@ -1051,7 +1082,7 @@ begin
| |1|2|3| |K| | | | |1|2|3| |K| | |
+-+-+-+-+-------+-+-------------+ - - - - - - - - - - - - - - - + *) +-+-+-+-+-------+-+-------------+ - - - - - - - - - - - - - - - + *)
//FIN, RSV1, RSV2, RSV3: 1 bit each //FIN, RSV1, RSV2, RSV3: 1 bit each
if aFIN then iByte := (1 shl 7); if aFIN then iByte := (1 shl 7) else iByte := 0;
if aRSV1 then iByte := iByte + (1 shl 6); if aRSV1 then iByte := iByte + (1 shl 6);
if aRSV2 then iByte := iByte + (1 shl 5); if aRSV2 then iByte := iByte + (1 shl 5);
if aRSV3 then iByte := iByte + (1 shl 4); if aRSV3 then iByte := iByte + (1 shl 4);
@ -1137,7 +1168,17 @@ begin
ioffset := 0; ioffset := 0;
repeat repeat
//Result := Binding.Send(bData, ioffset); //Result := Binding.Send(bData, ioffset);
Result := inherited WriteDataToTarget(bdata, iOffset, (Length(bData) - ioffset)); //ssl compatible? //
Result := inherited WriteDataToTarget(bdata, iOffset, (Length(bData) - ioffset)); //ssl compatible?
if Result<0 then
begin
// IO error ; probably connexion closed by peer on protocol error ?
{$IFDEF DEBUG_WS}
if Debughook > 0 then
OutputDebugString(PChar(Format('WriteError ThrID:%d, L:%d, R:%d',[getcurrentthreadid,Length(bData)-ioffset,Result])));
{$ENDIF}
break;
end;
Inc(ioffset, Result); Inc(ioffset, Result);
until ioffset >= Length(bData); until ioffset >= Length(bData);

38
IdServerIOHandlerWebsocket.pas
View file

@ -1,16 +1,33 @@
unit IdServerIOHandlerWebsocket; unit IdServerIOHandlerWebsocket;
interface interface
{$I wsdefines.pas}
uses uses
Classes, Classes
IdServerIOHandlerStack, IdIOHandlerStack, IdGlobal, IdIOHandler, IdYarn, IdThread, IdSocketHandle, , IdServerIOHandlerStack
IdIOHandlerWebsocket; , IdIOHandlerStack
, IdGlobal
, IdIOHandler
, IdYarn
, IdThread
, IdSocketHandle
//
, IdIOHandlerWebsocket
{$IFDEF WEBSOCKETSSL}
, IdSSLOpenSSL
{$ENDIF}
;
type type
{$IFDEF WEBSOCKETSSL}
TIdServerIOHandlerWebsocket = class(TIdServerIOHandlerSSLOpenSSL)
{$ELSE}
TIdServerIOHandlerWebsocket = class(TIdServerIOHandlerStack) TIdServerIOHandlerWebsocket = class(TIdServerIOHandlerStack)
{$ENDIF}
protected protected
procedure InitComponent; override; procedure InitComponent; override;
{$IFDEF WEBSOCKETSSL}
function CreateOpenSSLSocket:TIdSSLIOHandlerSocketOpenSSL; override;
{$ENDIF}
public public
function Accept(ASocket: TIdSocketHandle; AListenerThread: TIdThread; function Accept(ASocket: TIdSocketHandle; AListenerThread: TIdThread;
AYarn: TIdYarn): TIdIOHandler; override; AYarn: TIdYarn): TIdIOHandler; override;
@ -21,6 +38,13 @@ implementation
{ TIdServerIOHandlerStack_Websocket } { TIdServerIOHandlerStack_Websocket }
{$IFDEF WEBSOCKETSSL}
function TIdServerIOHandlerWebsocket.CreateOpenSSLSocket:TIdSSLIOHandlerSocketOpenSSL;
begin
Result := TIdIOHandlerWebsocket.Create(nil);
end;
{$ENDIF}
function TIdServerIOHandlerWebsocket.Accept(ASocket: TIdSocketHandle; function TIdServerIOHandlerWebsocket.Accept(ASocket: TIdSocketHandle;
AListenerThread: TIdThread; AYarn: TIdYarn): TIdIOHandler; AListenerThread: TIdThread; AYarn: TIdYarn): TIdIOHandler;
begin begin
@ -35,18 +59,22 @@ end;
procedure TIdServerIOHandlerWebsocket.InitComponent; procedure TIdServerIOHandlerWebsocket.InitComponent;
begin begin
inherited InitComponent; inherited InitComponent;
{$IFNDEF WEBSOCKETSSL}
IOHandlerSocketClass := TIdIOHandlerWebsocket; IOHandlerSocketClass := TIdIOHandlerWebsocket;
{$ENDIF}
end; end;
function TIdServerIOHandlerWebsocket.MakeClientIOHandler( function TIdServerIOHandlerWebsocket.MakeClientIOHandler(
ATheThread: TIdYarn): TIdIOHandler; ATheThread: TIdYarn): TIdIOHandler;
begin begin
Result := inherited MakeClientIOHandler(ATheThread); Result := inherited MakeClientIOHandler(ATheThread);
{$IFNDEF WEBSOCKETSSL}
if Result <> nil then if Result <> nil then
begin begin
(Result as TIdIOHandlerWebsocket).IsServerSide := True; //server must not mask, only client (Result as TIdIOHandlerWebsocket).IsServerSide := True; //server must not mask, only client
(Result as TIdIOHandlerWebsocket).UseNagle := False; (Result as TIdIOHandlerWebsocket).UseNagle := False;
end; end;
{$ENDIF}
end; end;
end. end.

62
IdServerSocketIOHandling.pas
View file

@ -1,12 +1,18 @@
unit IdServerSocketIOHandling; unit IdServerSocketIOHandling;
interface interface
{$I wsdefines.pas}
uses uses
IdContext, IdCustomTCPServer, Classes, Generics.Collections, SysUtils, StrUtils
//IdServerWebsocketContext, , IdContext
Classes, Generics.Collections, , IdCustomTCPServer
superobject, IdException, IdServerBaseHandling, IdSocketIOHandling; , IdException
//
{$IFDEF SUPEROBJECT}
, superobject
{$ENDIF}
, IdServerBaseHandling
, IdSocketIOHandling
;
type type
TIdServerSocketIOHandling = class(TIdBaseSocketIOHandling) TIdServerSocketIOHandling = class(TIdBaseSocketIOHandling)
@ -15,22 +21,27 @@ type
public public
function SendToAll(const aMessage: string; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = 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; const aOnError: TSocketIOError = 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; const aOnError: TSocketIOError = nil): Integer;overload;
function EmitEventToAll(const aEventName: string; const aData: string ; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil): Integer;overload; function EmitEventToAll(const aEventName: string; const aData: string ; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil): Integer;overload;
procedure EmitEventTo (const aContext: ISocketIOContext; {$IFDEF SUPEROBJECT}
const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);overload; function EmitEventToAll(const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil): Integer;overload;
procedure EmitEventTo (const aContext: TIdServerContext; procedure EmitEventTo (const aContext: TIdServerContext;
const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);overload; const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);overload;
procedure EmitEventTo (const aContext: ISocketIOContext;
const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);overload;
{$ENDIF}
end; end;
implementation implementation
uses
SysUtils, StrUtils;
{ TIdServerSocketIOHandling } { TIdServerSocketIOHandling }
procedure TIdServerSocketIOHandling.ProcessHeatbeatRequest(
const AContext: ISocketIOContext; const aText: string);
begin
inherited ProcessHeatbeatRequest(AContext, aText);
end;
{$IFDEF SUPEROBJECT}
procedure TIdServerSocketIOHandling.EmitEventTo( procedure TIdServerSocketIOHandling.EmitEventTo(
const aContext: ISocketIOContext; const aEventName: string; const aContext: ISocketIOContext; const aEventName: string;
const aData: ISuperObject; const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError); const aData: ISuperObject; const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
@ -72,6 +83,16 @@ begin
end; end;
end; end;
function TIdServerSocketIOHandling.EmitEventToAll(const aEventName: string; const aData: ISuperObject;
const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError): Integer;
begin
if aData.IsType(stString) then
Result := EmitEventToAll(aEventName, '"' + aData.AsString + '"', aCallback, aOnError)
else
Result := EmitEventToAll(aEventName, aData.AsString, aCallback, aOnError);
end;
{$ENDIF}
function TIdServerSocketIOHandling.EmitEventToAll(const aEventName, function TIdServerSocketIOHandling.EmitEventToAll(const aEventName,
aData: string; const aCallback: TSocketIOMsgJSON; aData: string; const aCallback: TSocketIOMsgJSON;
const aOnError: TSocketIOError): Integer; const aOnError: TSocketIOError): Integer;
@ -125,21 +146,6 @@ begin
end; end;
end; end;
function TIdServerSocketIOHandling.EmitEventToAll(const aEventName: string; const aData: ISuperObject;
const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError): Integer;
begin
if aData.IsType(stString) then
Result := EmitEventToAll(aEventName, '"' + aData.AsString + '"', aCallback, aOnError)
else
Result := EmitEventToAll(aEventName, aData.AsString, aCallback, aOnError);
end;
procedure TIdServerSocketIOHandling.ProcessHeatbeatRequest(
const AContext: ISocketIOContext; const aText: string);
begin
inherited ProcessHeatbeatRequest(AContext, aText);
end;
procedure TIdServerSocketIOHandling.SendTo(const aContext: TIdServerContext; procedure TIdServerSocketIOHandling.SendTo(const aContext: TIdServerContext;
const aMessage: string; const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError); const aMessage: string; const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
var var

23
IdServerWebsocketContext.pas
View file

@ -1,16 +1,22 @@
unit IdServerWebsocketContext; unit IdServerWebsocketContext;
interface interface
{$I wsdefines.pas}
uses uses
Classes, Classes, strUtils
IdCustomTCPServer, IdIOHandlerWebsocket, , IdContext
IdServerBaseHandling, IdServerSocketIOHandling, IdContext; , IdCustomTCPServer
, IdCustomHTTPServer
//
, IdIOHandlerWebsocket
, IdServerBaseHandling
, IdServerSocketIOHandling
;
type type
TIdServerWSContext = class; TIdServerWSContext = class;
TWebsocketChannelRequest = procedure(const AContext: TIdServerWSContext; aType: TWSDataType; const strmRequest, strmResponse: TMemoryStream) of object; TWebSocketUpgradeEvent = procedure(const AContext: TIdServerWSContext; ARequestInfo: TIdHTTPRequestInfo; var Accept:boolean) of object;
TWebsocketChannelRequest = procedure(const AContext: TIdServerWSContext; var aType:TWSDataType; const strmRequest, strmResponse: TMemoryStream) of object;
TIdServerWSContext = class(TIdServerContext) TIdServerWSContext = class(TIdServerContext)
private private
@ -25,6 +31,7 @@ type
FWebSocketExtensions: string; FWebSocketExtensions: string;
FCookie: string; FCookie: string;
//FSocketIOPingSend: Boolean; //FSocketIOPingSend: Boolean;
fOnWebSocketUpgrade: TWebSocketUpgradeEvent;
FOnCustomChannelExecute: TWebsocketChannelRequest; FOnCustomChannelExecute: TWebsocketChannelRequest;
FSocketIO: TIdServerSocketIOHandling; FSocketIO: TIdServerSocketIOHandling;
FOnDestroy: TIdContextEvent; FOnDestroy: TIdContextEvent;
@ -50,14 +57,12 @@ type
property WebSocketVersion : Integer read FWebSocketVersion write FWebSocketVersion; property WebSocketVersion : Integer read FWebSocketVersion write FWebSocketVersion;
property WebSocketExtensions: string read FWebSocketExtensions write FWebSocketExtensions; property WebSocketExtensions: string read FWebSocketExtensions write FWebSocketExtensions;
public public
property OnWebSocketUpgrade: TWebsocketUpgradeEvent read FOnWebSocketUpgrade write FOnWebSocketUpgrade;
property OnCustomChannelExecute: TWebsocketChannelRequest read FOnCustomChannelExecute write FOnCustomChannelExecute; property OnCustomChannelExecute: TWebsocketChannelRequest read FOnCustomChannelExecute write FOnCustomChannelExecute;
end; end;
implementation implementation
uses
StrUtils;
{ TIdServerWSContext } { TIdServerWSContext }
destructor TIdServerWSContext.Destroy; destructor TIdServerWSContext.Destroy;

57
IdServerWebsocketHandling.pas
View file

@ -1,16 +1,24 @@
unit IdServerWebsocketHandling; unit IdServerWebsocketHandling;
interface interface
{$I wsdefines.pas}
uses uses
IdContext, IdCustomHTTPServer, Classes, StrUtils, SysUtils, DateUtils
, IdCoderMIME
, IdThread
, IdContext
, IdCustomHTTPServer
{$IF CompilerVersion <= 21.0} //D2010 {$IF CompilerVersion <= 21.0} //D2010
IdHashSHA1, , IdHashSHA1
{$else} {$else}
IdHashSHA, //XE3 etc , IdHashSHA //XE3 etc
{$IFEND} {$IFEND}
IdServerSocketIOHandling, IdServerWebsocketContext, , IdServerSocketIOHandling
Classes, IdServerBaseHandling, IdIOHandlerWebsocket, IdSocketIOHandling; //
, IdSocketIOHandling
, IdServerBaseHandling
, IdServerWebsocketContext
, IdIOHandlerWebsocket
;
type type
TIdServerSocketIOHandling_Ext = class(TIdServerSocketIOHandling) TIdServerSocketIOHandling_Ext = class(TIdServerSocketIOHandling)
@ -19,7 +27,7 @@ type
TIdServerWebsocketHandling = class(TIdServerBaseHandling) TIdServerWebsocketHandling = class(TIdServerBaseHandling)
protected protected
class procedure DoWSExecute(AThread: TIdContext; aSocketIOHandler: TIdServerSocketIOHandling_Ext);virtual; class procedure DoWSExecute(AThread: TIdContext; aSocketIOHandler: TIdServerSocketIOHandling_Ext);virtual;
class procedure HandleWSMessage(AContext: TIdServerWSContext; aType: TWSDataType; class procedure HandleWSMessage(AContext: TIdServerWSContext; var aType: TWSDataType;
aRequestStrm, aResponseStrm: TMemoryStream; aRequestStrm, aResponseStrm: TMemoryStream;
aSocketIOHandler: TIdServerSocketIOHandling_Ext);virtual; aSocketIOHandler: TIdServerSocketIOHandling_Ext);virtual;
public public
@ -31,10 +39,6 @@ type
implementation implementation
uses
StrUtils, SysUtils, DateUtils,
IdCustomTCPServer, IdCoderMIME, IdThread;
{ TIdServerWebsocketHandling } { TIdServerWebsocketHandling }
class function TIdServerWebsocketHandling.CurrentSocket: ISocketIOContext; class function TIdServerWebsocketHandling.CurrentSocket: ISocketIOContext;
@ -103,23 +107,20 @@ begin
Continue; Continue;
end; end;
if wscode = wdcText then if wscode = wdcText
wstype := wdtText then wstype := wdtText
else else wstype := wdtBinary;
wstype := wdtBinary;
HandleWSMessage(context, wstype, strmRequest, strmResponse, aSocketIOHandler); HandleWSMessage(context, wstype, strmRequest, strmResponse, aSocketIOHandler);
//write result back (of the same type: text or bin) //write result back (of the same type: text or bin)
if strmResponse.Size > 0 then if strmResponse.Size > 0 then
begin begin
if wscode = wdcText then if wstype = wdtText
context.IOHandler.Write(strmResponse, wdtText) then context.IOHandler.Write(strmResponse, wdtText)
else else context.IOHandler.Write(strmResponse, wdtBinary)
context.IOHandler.Write(strmResponse, wdtBinary)
end end
else else context.IOHandler.WriteData(nil, wdcPing);
context.IOHandler.WriteData(nil, wdcPing);
finally finally
strmRequest.Free; strmRequest.Free;
strmResponse.Free; strmResponse.Free;
@ -152,9 +153,7 @@ begin
end; end;
end; end;
class procedure TIdServerWebsocketHandling.HandleWSMessage(AContext: TIdServerWSContext; aType: TWSDataType; class procedure TIdServerWebsocketHandling.HandleWSMessage(AContext: TIdServerWSContext; var aType:TWSDataType; aRequestStrm, aResponseStrm: TMemoryStream; aSocketIOHandler: TIdServerSocketIOHandling_Ext);
aRequestStrm, aResponseStrm: TMemoryStream;
aSocketIOHandler: TIdServerSocketIOHandling_Ext);
begin begin
if AContext.IsSocketIO then if AContext.IsSocketIO then
begin begin
@ -170,6 +169,7 @@ class function TIdServerWebsocketHandling.ProcessServerCommandGet(
AThread: TIdServerWSContext; ARequestInfo: TIdHTTPRequestInfo; AThread: TIdServerWSContext; ARequestInfo: TIdHTTPRequestInfo;
AResponseInfo: TIdHTTPResponseInfo): Boolean; AResponseInfo: TIdHTTPResponseInfo): Boolean;
var var
Accept: Boolean;
sValue, squid: string; sValue, squid: string;
context: TIdServerWSContext; context: TIdServerWSContext;
hash: TIdHashSHA1; hash: TIdHashSHA1;
@ -244,6 +244,13 @@ begin
Result := True; //handled Result := True; //handled
context := AThread as TIdServerWSContext; context := AThread as TIdServerWSContext;
if Assigned(Context.OnWebSocketUpgrade) then
begin
Accept := True;
Context.OnWebSocketUpgrade(Context,ARequestInfo,Accept);
if not Accept then Abort;
end;
//Sec-WebSocket-Key: dGhlIHNhbXBsZSBub25jZQ== //Sec-WebSocket-Key: dGhlIHNhbXBsZSBub25jZQ==
sValue := ARequestInfo.RawHeaders.Values['sec-websocket-key']; sValue := ARequestInfo.RawHeaders.Values['sec-websocket-key'];
//"The value of this header field MUST be a nonce consisting of a randomly //"The value of this header field MUST be a nonce consisting of a randomly

227
IdSocketIOHandling.pas
View file

@ -1,14 +1,24 @@
unit IdSocketIOHandling; unit IdSocketIOHandling;
interface interface
{$I wsdefines.pas}
uses uses
Classes, Generics.Collections, windows, SyncObjs, SysUtils, StrUtils, Classes, Generics.Collections
superobject, {$IFDEF SUPEROBJECT}
IdServerBaseHandling, IdContext, IdException, IdIOHandlerWebsocket, IdHTTP, , superobject
SyncObjs, SysUtils; {$ENDIF}
, IdContext
, IdException
, IdHTTP
//
, IdServerBaseHandling
, IdIOHandlerWebsocket
;
type type
{$IFNDEF SUPEROBJECT}
TSuperArray = String;
{$ENDIF}
TSocketIOContext = class; TSocketIOContext = class;
TSocketIOCallbackObj = class; TSocketIOCallbackObj = class;
TIdBaseSocketIOHandling = class; TIdBaseSocketIOHandling = class;
@ -18,9 +28,13 @@ type
ISocketIOCallback = interface; ISocketIOCallback = interface;
TSocketIOMsg = reference to procedure(const ASocket: ISocketIOContext; const aText: string; const aCallback: ISocketIOCallback); TSocketIOMsg = reference to procedure(const ASocket: ISocketIOContext; const aText: string; const aCallback: ISocketIOCallback);
{$IFDEF SUPEROBJECT}
TSocketIOMsgJSON = reference to procedure(const ASocket: ISocketIOContext; const aJSON: ISuperObject; const aCallback: ISocketIOCallback); TSocketIOMsgJSON = reference to procedure(const ASocket: ISocketIOContext; const aJSON: ISuperObject; const aCallback: ISocketIOCallback);
TSocketIONotify = reference to procedure(const ASocket: ISocketIOContext); {$ELSE}
TSocketIOMsgJSON = reference to procedure(const ASocket: ISocketIOContext; const aJSON:string; const aCallback: ISocketIOCallback);
{$ENDIF}
TSocketIOEvent = reference to procedure(const ASocket: ISocketIOContext; const aArgument: TSuperArray; const aCallback: ISocketIOCallback); TSocketIOEvent = reference to procedure(const ASocket: ISocketIOContext; const aArgument: TSuperArray; const aCallback: ISocketIOCallback);
TSocketIONotify = reference to procedure(const ASocket: ISocketIOContext);
TSocketIOError = reference to procedure(const ASocket: ISocketIOContext; const aErrorClass, aErrorMessage: string); TSocketIOError = reference to procedure(const ASocket: ISocketIOContext; const aErrorClass, aErrorMessage: string);
TSocketIOEventError = reference to procedure(const ASocket: ISocketIOContext; const aCallback: ISocketIOCallback; E: Exception); TSocketIOEventError = reference to procedure(const ASocket: ISocketIOContext; const aCallback: ISocketIOCallback; E: Exception);
@ -48,14 +62,15 @@ type
function IsDisconnected: Boolean; function IsDisconnected: Boolean;
{$IFDEF SUPEROBJECT}
procedure EmitEvent(const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);overload; procedure EmitEvent(const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);overload;
procedure SendJSON(const aJSON: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);
{$ENDIF}
procedure EmitEvent(const aEventName: string; const aData: string; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);overload; procedure EmitEvent(const aEventName: string; const aData: string; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);overload;
procedure Send(const aData: string; 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; end;
TSocketIOContext = class(TInterfacedObject, TSocketIOContext = class(TInterfacedObject,ISocketIOContext)
ISocketIOContext)
private private
FLock: TCriticalSection; FLock: TCriticalSection;
FPingSend: Boolean; FPingSend: Boolean;
@ -104,14 +119,15 @@ type
property CustomData: TObject read GetCustomData write SetCustomData; property CustomData: TObject read GetCustomData write SetCustomData;
property OwnsCustomData: Boolean read GetOwnsCustomData write SetOwnsCustomData; property OwnsCustomData: Boolean read GetOwnsCustomData write SetOwnsCustomData;
procedure EmitEvent(const aEventName: string; const aData: string; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);overload;
procedure Send(const aData: string; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);
{$IFDEF SUPEROBJECT}
//todo: OnEvent per socket //todo: OnEvent per socket
//todo: store session info per connection (see Socket.IO Set + Get -> Storing data associated to a client) //todo: store session info per connection (see Socket.IO Set + Get -> Storing data associated to a client)
//todo: namespace using "Of" //todo: namespace using "Of"
procedure EmitEvent(const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);overload; procedure EmitEvent(const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);overload;
procedure EmitEvent(const aEventName: string; const aData: string; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);overload;
// procedure BroadcastEventToOthers(const aEventName: string; const aData: 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); procedure SendJSON(const aJSON: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);
{$ENDIF}
end; end;
ISocketIOCallback = interface ISocketIOCallback = interface
@ -137,7 +153,9 @@ type
protected protected
Done, Success: Boolean; Done, Success: Boolean;
Error: Exception; Error: Exception;
{$IFDEF SUPEROBJECT}
Data : ISuperObject; Data : ISuperObject;
{$ENDIF}
Event: TEvent; Event: TEvent;
public public
procedure AfterConstruction; override; procedure AfterConstruction; override;
@ -158,7 +176,9 @@ type
FOnDisconnectList: TSocketIONotifyList; FOnDisconnectList: TSocketIONotifyList;
FOnEventList: TObjectDictionary<string,TSocketIOEventList>; FOnEventList: TObjectDictionary<string,TSocketIOEventList>;
FOnSocketIOMsg: TSocketIOMsg; FOnSocketIOMsg: TSocketIOMsg;
{$IFDEF SUPEROBJECT}
FOnSocketIOJson: TSocketIOMsgJSON; FOnSocketIOJson: TSocketIOMsgJSON;
{$ENDIF}
procedure ProcessEvent(const AContext: ISocketIOContext; const aText: string; aMsgNr: Integer; aHasCallback: Boolean); procedure ProcessEvent(const AContext: ISocketIOContext; const aText: string; aMsgNr: Integer; aHasCallback: Boolean);
private private
@ -186,7 +206,9 @@ type
procedure WriteSocketIOJSON(const ASocket: ISocketIOContext; const aRoom, aJSON: string; aCallback: TSocketIOCallbackRef = nil; const aOnError: TSocketIOError = nil); procedure WriteSocketIOJSON(const ASocket: ISocketIOContext; const aRoom, aJSON: string; aCallback: TSocketIOCallbackRef = nil; const aOnError: TSocketIOError = nil);
procedure WriteSocketIOEvent(const ASocket: ISocketIOContext; const aRoom, aEventName, aJSONArray: string; aCallback: TSocketIOCallback; const aOnError: TSocketIOError); procedure WriteSocketIOEvent(const ASocket: ISocketIOContext; const aRoom, aEventName, aJSONArray: string; aCallback: TSocketIOCallback; const aOnError: TSocketIOError);
procedure WriteSocketIOEventRef(const ASocket: ISocketIOContext; const aRoom, aEventName, aJSONArray: string; aCallback: TSocketIOCallbackRef; const aOnError: TSocketIOError); procedure WriteSocketIOEventRef(const ASocket: ISocketIOContext; const aRoom, aEventName, aJSONArray: string; aCallback: TSocketIOCallbackRef; const aOnError: TSocketIOError);
{$IFDEF SUPEROBJECT}
function WriteSocketIOEventSync(const ASocket: ISocketIOContext; const aRoom, aEventName, aJSONArray: string; aMaxwait_ms: Cardinal = INFINITE): ISuperObject; function WriteSocketIOEventSync(const ASocket: ISocketIOContext; const aRoom, aEventName, aJSONArray: string; aMaxwait_ms: Cardinal = INFINITE): ISuperObject;
{$ENDIF}
procedure WriteSocketIOResult(const ASocket: ISocketIOContext; aRequestMsgNr: Integer; const aRoom, aData: string); procedure WriteSocketIOResult(const ASocket: ISocketIOContext; aRequestMsgNr: Integer; const aRoom, aData: string);
procedure ProcessSocketIO_XHR(const aGUID: string; const aStrmRequest, aStrmResponse: TStream); procedure ProcessSocketIO_XHR(const aGUID: string; const aStrmRequest, aStrmResponse: TStream);
@ -215,7 +237,9 @@ type
procedure FreeConnection(const ASocket: ISocketIOContext);overload; procedure FreeConnection(const ASocket: ISocketIOContext);overload;
property OnSocketIOMsg : TSocketIOMsg read FOnSocketIOMsg write FOnSocketIOMsg; property OnSocketIOMsg : TSocketIOMsg read FOnSocketIOMsg write FOnSocketIOMsg;
{$IFDEF SUPEROBJECT}
property OnSocketIOJson : TSocketIOMsgJSON read FOnSocketIOJson write FOnSocketIOJson; property OnSocketIOJson : TSocketIOMsgJSON read FOnSocketIOJson write FOnSocketIOJson;
{$ENDIF}
procedure OnEvent (const aEventName: string; const aCallback: TSocketIOEvent); procedure OnEvent (const aEventName: string; const aCallback: TSocketIOEvent);
procedure OnConnection(const aCallback: TSocketIONotify); procedure OnConnection(const aCallback: TSocketIONotify);
@ -228,15 +252,29 @@ type
TIdSocketIOHandling = class(TIdBaseSocketIOHandling) TIdSocketIOHandling = class(TIdBaseSocketIOHandling)
public public
procedure Send(const aMessage: string; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil); procedure Send(const aMessage: string; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);
procedure Emit(const aEventName: string; const aData: string; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);overload;
{$IFDEF SUPEROBJECT}
procedure Emit(const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);overload; procedure Emit(const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);overload;
function EmitSync(const aEventName: string; const aData: ISuperObject; aMaxwait_ms: Cardinal = INFINITE): ISuperobject; function EmitSync(const aEventName: string; const aData: ISuperObject; aMaxwait_ms: Cardinal = INFINITE): ISuperobject;
//procedure Emit(const aEventName: string; const aData: string; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);overload; //procedure Emit(const aEventName: string; const aData: string; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);overload;
{$ENDIF}
end; end;
{$IFNDEF SUPEROBJECT}
function SO(const S:string):string; inline;
{$ENDIF}
implementation implementation
uses uses
StrUtils, IdServerWebsocketContext, IdHTTPWebsocketClient, Windows; IdServerWebsocketContext, IdHTTPWebsocketClient;
{$IFNDEF SUPEROBJECT}
function SO(const S:string):string; inline;
begin
Result := S;
end;
{$ENDIF}
procedure TIdBaseSocketIOHandling.AfterConstruction; procedure TIdBaseSocketIOHandling.AfterConstruction;
begin begin
@ -502,8 +540,7 @@ begin
FOnDisconnectList.Add(aCallback); FOnDisconnectList.Add(aCallback);
end; end;
procedure TIdBaseSocketIOHandling.OnEvent(const aEventName: string; procedure TIdBaseSocketIOHandling.OnEvent(const aEventName: string; const aCallback: TSocketIOEvent);
const aCallback: TSocketIOEvent);
var list: TSocketIOEventList; var list: TSocketIOEventList;
begin begin
if not FOnEventList.TryGetValue(aEventName, list) then if not FOnEventList.TryGetValue(aEventName, list) then
@ -523,26 +560,86 @@ begin
TSocketIOContext(ASocket).FContext.Connection.Disconnect; TSocketIOContext(ASocket).FContext.Connection.Disconnect;
end; end;
procedure TIdBaseSocketIOHandling.ProcessEvent( procedure TIdBaseSocketIOHandling.ProcessEvent(const AContext: ISocketIOContext; const aText: string; aMsgNr: Integer;aHasCallback: Boolean);
const AContext: ISocketIOContext; const aText: string; aMsgNr: Integer;
aHasCallback: Boolean);
var var
json: ISuperObject;
name: string; name: string;
{$IFNDEF SUPEROBJECT}
args: string;
{$ELSE}
args: TSuperArray; args: TSuperArray;
json: ISuperObject;
// socket: TSocketIOContext;
{$ENDIF}
list: TSocketIOEventList; list: TSocketIOEventList;
event: TSocketIOEvent; event: TSocketIOEvent;
callback: ISocketIOCallback; callback: ISocketIOCallback;
// socket: TSocketIOContext;
{$IFNDEF SUPEROBJECT}
function _GetJsonMember(const aText:string; const iName:string):string;
var xs,xe,ctn:Integer;
begin
// Based on json formated content
Result := '';
xs := Pos('"'+iName+'"',aText);
if xs=0 then Exit;
xs := PosEx(':',aText,xs);
if xs=0 then Exit;
//
inc(xs);
while (xs<=length(aText)) and (aText[xs] in [' ',#13,#10,#8,#9]) do inc(xs);
if xs>=length(aText) then Exit;
//
if aText[xs]='[' then
begin
xe := xs+1; ctn := 1;
while (xe<=length(aText)) do
begin
if aText[xe]='[' then inc(ctn);
if aText[xe]=']' then dec(ctn);
if ctn=0 then break;
inc(xe);
end;
if ctn=0 then
Result := Copy(aText,xs,xe-xs+1);
end
else
if aText[xs]='{' then
begin
xe := xs+1; ctn := 1;
while (xe<=length(aText)) do
begin
if aText[xe]='{' then inc(ctn);
if aText[xe]='}' then dec(ctn);
if ctn=0 then break;
inc(xe);
end;
if ctn=0 then
Result := Copy(aText,xs,xe-xs+1);
end
else
if aText[xs]='"' then
begin
xe := PosEx('"',aText,xs+1);
if xe=0 then Exit;
Result := Copy(aText,xs+1,xe-xs-1);
end;
end;
{$ENDIF}
begin begin
//'5:' [message id ('+')] ':' [message endpoint] ':' [json encoded event] //'5:' [message id ('+')] ':' [message endpoint] ':' [json encoded event]
//5::/chat:{"name":"my other event","args":[{"my":"data"}]} //5::/chat:{"name":"my other event","args":[{"my":"data"}]}
//5:1+:/chat:{"name":"GetLocations","args":[""]} //5:1+:/chat:{"name":"GetLocations","args":[""]}
{$IFNDEF SUPEROBJECT}
name := _GetJsonMember(aText,'name'); //"my other event
args := _GetJsonMember(aText,'args'); //[{"my":"data"}]
{$ELSE}
json := SO(aText); json := SO(aText);
// args := nil; // args := nil;
try try
name := json.S['name']; //"my other event name := json.S['name']; //"my other event
args := json.A['args']; //[{"my":"data"}] args := json.A['args']; //[{"my":"data"}]
{$ENDIF}
if FOnEventList.TryGetValue(name, list) then if FOnEventList.TryGetValue(name, list) then
begin begin
@ -563,7 +660,11 @@ begin
OnEventError(AContext, callback, e) OnEventError(AContext, callback, e)
else else
if callback <> nil then if callback <> nil then
{$IFNDEF SUPEROBJECT}
callback.SendResponse('Error');
{$ELSE}
callback.SendResponse( SO(['Error', SO(['msg', e.message])]).AsJSon ); callback.SendResponse( SO(['Error', SO(['msg', e.message])]).AsJSon );
{$ENDIF}
end; end;
finally finally
callback := nil; callback := nil;
@ -571,10 +672,13 @@ begin
end end
else else
raise EIdSocketIoUnhandledMessage.Create(aText); raise EIdSocketIoUnhandledMessage.Create(aText);
{$IFDEF SUPEROBJECT}
finally finally
// args.Free; //args.Free;
json := nil; json := nil;
end; end;
{$ENDIF}
end; end;
procedure TIdBaseSocketIOHandling.ProcessHeatbeatRequest(const ASocket: ISocketIOContext; const aText: string); procedure TIdBaseSocketIOHandling.ProcessHeatbeatRequest(const ASocket: ISocketIOContext; const aText: string);
@ -749,7 +853,9 @@ var
callbackref: TSocketIOCallbackRef; callbackref: TSocketIOCallbackRef;
callbackobj: ISocketIOCallback; callbackobj: ISocketIOCallback;
errorref: TSocketIOError; errorref: TSocketIOError;
{$IFDEF SUPEROBJECT}
error: ISuperObject; error: ISuperObject;
{$ENDIF}
socket: TSocketIOContext; socket: TSocketIOContext;
begin begin
if ASocket = nil then Exit; if ASocket = nil then Exit;
@ -822,8 +928,12 @@ begin
except except
on E:Exception do on E:Exception do
begin begin
{$IFDEF SUPEROBJECT}
if not callbackobj.IsResponseSend then if not callbackobj.IsResponseSend then
callbackobj.SendResponse( SO(['Error', SO(['Type', e.ClassName, 'Message', e.Message])]).AsJSon ); callbackobj.SendResponse( SO(['Error', SO(['Type', e.ClassName, 'Message', e.Message])]).AsJSon );
{$ELSE}
//TODO
{$ENDIF}
end; end;
end; end;
finally finally
@ -841,6 +951,7 @@ begin
//4:1::{"a":"b"} //4:1::{"a":"b"}
else if StartsStr('4:', str) then else if StartsStr('4:', str) then
begin begin
{$IFDEF SUPEROBJECT}
if Assigned(OnSocketIOJson) then if Assigned(OnSocketIOJson) then
begin begin
if bCallback then if bCallback then
@ -864,6 +975,7 @@ begin
OnSocketIOJson(ASocket, SO(sdata), nil); //, imsg, bCallback); OnSocketIOJson(ASocket, SO(sdata), nil); //, imsg, bCallback);
end end
else else
{$ENDIF}
raise EIdSocketIoUnhandledMessage.Create(str); raise EIdSocketIoUnhandledMessage.Create(str);
end end
//(5) Event //(5) Event
@ -895,6 +1007,7 @@ begin
begin begin
FSocketIOErrorRef.Remove(imsg); FSocketIOErrorRef.Remove(imsg);
//'[{"Error":{"Message":"Operation aborted","Type":"EAbort"}}]' //'[{"Error":{"Message":"Operation aborted","Type":"EAbort"}}]'
{$IFDEF SUPEROBJECT}
if ContainsText(sdata, '{"Error":') then if ContainsText(sdata, '{"Error":') then
begin begin
error := SO(sdata); error := SO(sdata);
@ -910,6 +1023,7 @@ begin
FSocketIOEventCallbackRef.Remove(imsg); FSocketIOEventCallbackRef.Remove(imsg);
Exit; Exit;
end; end;
{$ENDIF}
end; end;
if FSocketIOEventCallback.TryGetValue(imsg, callback) then if FSocketIOEventCallback.TryGetValue(imsg, callback) then
@ -1049,6 +1163,7 @@ begin
WriteString(ASocket, sresult); WriteString(ASocket, sresult);
end; end;
{$IFDEF SUPEROBJECT}
function TIdBaseSocketIOHandling.WriteSocketIOEventSync(const ASocket: ISocketIOContext; const aRoom, aEventName, function TIdBaseSocketIOHandling.WriteSocketIOEventSync(const ASocket: ISocketIOContext; const aRoom, aEventName,
aJSONArray: string; aMaxwait_ms: Cardinal = INFINITE): ISuperObject; aJSONArray: string; aMaxwait_ms: Cardinal = INFINITE): ISuperObject;
var var
@ -1133,7 +1248,7 @@ begin
promise.Free; promise.Free;
end; end;
end; end;
{$ENDIF}
procedure TIdBaseSocketIOHandling.WriteSocketIOJSON(const ASocket: ISocketIOContext; procedure TIdBaseSocketIOHandling.WriteSocketIOJSON(const ASocket: ISocketIOContext;
const aRoom, aJSON: string; aCallback: TSocketIOCallbackRef = nil; const aOnError: TSocketIOError = nil); const aRoom, aJSON: string; aCallback: TSocketIOCallbackRef = nil; const aOnError: TSocketIOError = nil);
var var
@ -1290,8 +1405,7 @@ begin
inherited; inherited;
end; end;
procedure TSocketIOContext.EmitEvent(const aEventName, aData: string; procedure TSocketIOContext.EmitEvent(const aEventName, aData: string; const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
begin begin
Assert(FHandling <> nil); Assert(FHandling <> nil);
@ -1307,14 +1421,15 @@ begin
end; end;
end; end;
procedure TSocketIOContext.EmitEvent(const aEventName: string; const aData: ISuperObject; {$IFDEF SUPEROBJECT}
const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError); procedure TSocketIOContext.EmitEvent(const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
begin begin
if aData <> nil then if aData <> nil then
EmitEvent(aEventName, aData.AsJSon, aCallback, aOnError) EmitEvent(aEventName, aData.AsJSon, aCallback, aOnError)
else else
EmitEvent(aEventName, '', aCallback, aOnError); EmitEvent(aEventName, '', aCallback, aOnError);
end; end;
{$ENDIF}
function TSocketIOContext.GetCustomData: TObject; function TSocketIOContext.GetCustomData: TObject;
begin begin
@ -1383,8 +1498,7 @@ begin
Result := (FClient as TIdHTTPWebsocketClient).WSResourceName Result := (FClient as TIdHTTPWebsocketClient).WSResourceName
end; end;
procedure TSocketIOContext.Send(const aData: string; procedure TSocketIOContext.Send(const aData: string; const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
begin begin
if not Assigned(aCallback) then if not Assigned(aCallback) then
FHandling.WriteSocketIOMsg(Self, '', aData) FHandling.WriteSocketIOMsg(Self, '', aData)
@ -1398,6 +1512,7 @@ begin
end; end;
end; end;
{$IFDEF SUPEROBJECT}
procedure TSocketIOContext.SendJSON(const aJSON: ISuperObject; procedure TSocketIOContext.SendJSON(const aJSON: ISuperObject;
const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError); const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
begin begin
@ -1412,7 +1527,7 @@ begin
end, aOnError); end, aOnError);
end; end;
end; end;
{$ENDIF}
procedure TSocketIOContext.ServerContextDestroy(AContext: TIdContext); procedure TSocketIOContext.ServerContextDestroy(AContext: TIdContext);
begin begin
Self.Context := nil; Self.Context := nil;
@ -1521,6 +1636,7 @@ end;
{ TIdSocketIOHandling } { TIdSocketIOHandling }
{$IFDEF SUPEROBJECT}
procedure TIdSocketIOHandling.Emit(const aEventName: string; procedure TIdSocketIOHandling.Emit(const aEventName: string;
const aData: ISuperObject; const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError); const aData: ISuperObject; const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
var var
@ -1621,6 +1737,52 @@ begin
Result := WriteSocketIOEventSync(firstcontext, ''{no room}, aEventName, jsonarray, aMaxwait_ms); Result := WriteSocketIOEventSync(firstcontext, ''{no room}, aEventName, jsonarray, aMaxwait_ms);
end; end;
{$ENDIF}
procedure TIdSocketIOHandling.Emit(const aEventName: string;
const aData: string; const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
var context: ISocketIOContext; isendcount: Integer;
begin
Lock;
try
isendcount := 0;
//note: client has single connection?
for context in FConnections.Values do
begin
if context.IsDisconnected then Continue;
if not Assigned(aCallback) then
WriteSocketIOEvent(context, ''{no room}, aEventName, aData, nil, nil)
else
WriteSocketIOEventRef(context, ''{no room}, aEventName, aData,
procedure(const aData: string)
begin
aCallback(context, SO(aData), nil);
end, aOnError);
Inc(isendcount);
end;
for context in FConnectionsGUID.Values do
begin
if context.IsDisconnected then Continue;
if not Assigned(aCallback) then
WriteSocketIOEvent(context, ''{no room}, aEventName, aData, nil, nil)
else
WriteSocketIOEventRef(context, ''{no room}, aEventName, aData,
procedure(const aData: string)
begin
aCallback(context, SO(aData), nil);
end, aOnError);
Inc(isendcount);
end;
if isendcount = 0 then
raise EIdSocketIoUnhandledMessage.Create('Cannot emit: no socket.io connections!');
finally
UnLock;
end;
end;
procedure TIdSocketIOHandling.Send(const aMessage: string; procedure TIdSocketIOHandling.Send(const aMessage: string;
const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError); const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
@ -1669,6 +1831,7 @@ begin
end; end;
end; end;
{ TSocketIOPromise } { TSocketIOPromise }
procedure TSocketIOPromise.AfterConstruction; procedure TSocketIOPromise.AfterConstruction;

65
IdWebsocketServer.pas
View file

@ -1,16 +1,41 @@
unit IdWebsocketServer; unit IdWebsocketServer;
interface interface
{$I wsdefines.pas}
uses uses
IdServerWebsocketHandling, IdServerSocketIOHandling, IdServerWebsocketContext, Classes
IdHTTPServer, IdContext, IdCustomHTTPServer, Classes, IdIOHandlerWebsocket; , IdStreamVCL
, IdGlobal
, IdWinsock2
, IdHTTPServer
, IdContext
, IdCustomHTTPServer
, IdHTTPWebBrokerBridge
//
, IdIOHandlerWebsocket
, IdServerIOHandlerWebsocket
, IdServerWebsocketContext
, IdServerWebsocketHandling
, IdServerSocketIOHandling
;
type type
TWebsocketMessageText = procedure(const AContext: TIdServerWSContext; const aText: string) of object; TWebsocketMessageText = procedure(const AContext: TIdServerWSContext; const aText: string) of object;
TWebsocketMessageBin = procedure(const AContext: TIdServerWSContext; const aData: TStream) of object; TWebsocketMessageBin = procedure(const AContext: TIdServerWSContext; const aData: TStream) of object;
{$IFDEF WEBSOCKETBRIDGE}
TMyIdHttpWebBrokerBridge = class(TidHttpWebBrokerBridge)
published
property OnCreatePostStream;
property OnDoneWithPostStream;
property OnCommandGet;
end;
{$ENDIF}
{$IFDEF WEBSOCKETBRIDGE}
TIdWebsocketServer = class(TMyIdHttpWebBrokerBridge)
{$ELSE}
TIdWebsocketServer = class(TIdHTTPServer) TIdWebsocketServer = class(TIdHTTPServer)
{$ENDIF}
private private
FSocketIO: TIdServerSocketIOHandling_Ext; FSocketIO: TIdServerSocketIOHandling_Ext;
FOnMessageText: TWebsocketMessageText; FOnMessageText: TWebsocketMessageText;
@ -19,12 +44,13 @@ type
function GetSocketIO: TIdServerSocketIOHandling; function GetSocketIO: TIdServerSocketIOHandling;
procedure SetWriteTimeout(const Value: Integer); procedure SetWriteTimeout(const Value: Integer);
protected protected
procedure DoCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; function WebSocketCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo):boolean;
AResponseInfo: TIdHTTPResponseInfo); override; procedure DoCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); override;
procedure ContextCreated(AContext: TIdContext); override; procedure ContextCreated(AContext: TIdContext); override;
procedure ContextDisconnected(AContext: TIdContext); override; procedure ContextDisconnected(AContext: TIdContext); override;
procedure WebsocketChannelRequest(const AContext: TIdServerWSContext; aType: TWSDataType; const aStrmRequest, aStrmResponse: TMemoryStream); procedure WebsocketUpgradeRequest(const AContext: TIdServerWSContext; ARequestInfo: TIdHTTPRequestInfo; var Accept:boolean); virtual;
procedure WebsocketChannelRequest(const AContext: TIdServerWSContext; var aType:TWSDataType; const aStrmRequest, aStrmResponse: TMemoryStream); virtual;
public public
procedure AfterConstruction; override; procedure AfterConstruction; override;
destructor Destroy; override; destructor Destroy; override;
@ -42,9 +68,6 @@ type
implementation implementation
uses
IdServerIOHandlerWebsocket, IdStreamVCL, IdGlobal, Windows, IdWinsock2;
{ TIdWebsocketServer } { TIdWebsocketServer }
procedure TIdWebsocketServer.AfterConstruction; procedure TIdWebsocketServer.AfterConstruction;
@ -82,13 +105,20 @@ begin
FSocketIO.Free; FSocketIO.Free;
end; end;
procedure TIdWebsocketServer.DoCommandGet(AContext: TIdContext; function TIdWebsocketServer.WebSocketCommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo):boolean;
begin begin
(AContext as TIdServerWSContext).OnWebSocketUpgrade := Self.WebSocketUpgradeRequest;
(AContext as TIdServerWSContext).OnCustomChannelExecute := Self.WebsocketChannelRequest; (AContext as TIdServerWSContext).OnCustomChannelExecute := Self.WebsocketChannelRequest;
(AContext as TIdServerWSContext).SocketIO := FSocketIO; (AContext as TIdServerWSContext).SocketIO := FSocketIO;
if not TIdServerWebsocketHandling.ProcessServerCommandGet(AContext as TIdServerWSContext, ARequestInfo, AResponseInfo) then Result := TIdServerWebsocketHandling.ProcessServerCommandGet(AContext as TIdServerWSContext, ARequestInfo, AResponseInfo);
end;
procedure TIdWebsocketServer.DoCommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
begin
if not WebSocketCommandGet(AContext,ARequestInfo,AResponseInfo) then
inherited DoCommandGet(AContext, ARequestInfo, AResponseInfo); inherited DoCommandGet(AContext, ARequestInfo, AResponseInfo);
end; end;
@ -124,9 +154,12 @@ begin
FWriteTimeout := Value; FWriteTimeout := Value;
end; end;
procedure TIdWebsocketServer.WebsocketChannelRequest( procedure TIdWebsocketServer.WebsocketUpgradeRequest(const AContext: TIdServerWSContext; ARequestInfo: TIdHTTPRequestInfo; var Accept:boolean);
const AContext: TIdServerWSContext; aType: TWSDataType; const aStrmRequest, begin
aStrmResponse: TMemoryStream); Accept := True;
end;
procedure TIdWebsocketServer.WebsocketChannelRequest(const AContext: TIdServerWSContext; var aType:TWSDataType; const aStrmRequest,aStrmResponse: TMemoryStream);
var s: string; var s: string;
begin begin
if aType = wdtText then if aType = wdtText then