* Add defines for supporting SSL and HTTPBridge and removing SUPEROBJECT dependency
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
parent
8e7f63aeb6
commit
cdffdd25e1
|
|
@ -14,7 +14,7 @@ program UnitTestWebsockets;
|
|||
{$APPTYPE CONSOLE}
|
||||
{$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}
|
||||
|
||||
|
|
|
|||
|
|
@ -156,7 +156,7 @@ begin
|
|||
//* client to server */
|
||||
received := '';
|
||||
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
|
||||
received := aArgument.ToJson;
|
||||
end);
|
||||
|
|
@ -180,7 +180,7 @@ begin
|
|||
//* server to client */
|
||||
received := '';
|
||||
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
|
||||
received := aArgument.ToJson;
|
||||
end);
|
||||
|
|
@ -205,12 +205,12 @@ begin
|
|||
//* client to server */
|
||||
FLastSocketIOMsg := '';
|
||||
IndyHTTPWebsocketServer1.SocketIO.OnSocketIOMsg :=
|
||||
procedure(const ASocket: ISocketIOContext; const aText: string; const aCallback: TSocketIOCallbackObj)
|
||||
procedure(const ASocket: ISocketIOContext; const aText: string; const aCallback: ISocketIOCallback)
|
||||
begin
|
||||
Abort;
|
||||
end;
|
||||
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
|
||||
FLastSocketIOMsg := aJSON.AsString;
|
||||
end);
|
||||
|
|
@ -223,7 +223,7 @@ begin
|
|||
|
||||
FLastSocketIOMsg := '';
|
||||
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
|
||||
Assert(False, 'should go to error handling callback');
|
||||
FLastSocketIOMsg := 'error';
|
||||
|
|
@ -252,7 +252,7 @@ begin
|
|||
//* client to server */
|
||||
FLastSocketIOMsg := '';
|
||||
IndyHTTPWebsocketServer1.SocketIO.OnSocketIOMsg :=
|
||||
procedure(const ASocket: ISocketIOContext; const aText: string; const aCallback: TSocketIOCallbackObj)
|
||||
procedure(const ASocket: ISocketIOContext; const aText: string; const aCallback: ISocketIOCallback)
|
||||
begin
|
||||
FLastSocketIOMsg := aText;
|
||||
end;
|
||||
|
|
@ -267,7 +267,7 @@ begin
|
|||
//* server to client */
|
||||
FLastSocketIOMsg := '';
|
||||
IndyHTTPWebsocketClient1.SocketIO.OnSocketIOMsg :=
|
||||
procedure(const ASocket: ISocketIOContext; const aText: string; const aCallback: TSocketIOCallbackObj)
|
||||
procedure(const ASocket: ISocketIOContext; const aText: string; const aCallback: ISocketIOCallback)
|
||||
begin
|
||||
FLastSocketIOMsg := aText;
|
||||
end;
|
||||
|
|
|
|||
|
|
@ -1,23 +1,13 @@
|
|||
unit IdHTTPWebsocketClient;
|
||||
|
||||
interface
|
||||
|
||||
{$I wsdefines.pas}
|
||||
uses
|
||||
Classes,
|
||||
IdHTTP,
|
||||
{$IF CompilerVersion <= 21.0} //D2010
|
||||
IdHashSHA1,
|
||||
{$else}
|
||||
Types,
|
||||
IdHashSHA, //XE3 etc
|
||||
{$IFEND}
|
||||
IdIOHandler,
|
||||
IdIOHandlerWebsocket,
|
||||
{$ifdef FMX}
|
||||
FMX.Types,
|
||||
{$ELSE}
|
||||
ExtCtrls,
|
||||
{$ENDIF}
|
||||
IdWinsock2, Generics.Collections, SyncObjs,
|
||||
IdSocketIOHandling;
|
||||
|
||||
|
|
@ -557,7 +547,11 @@ begin
|
|||
begin
|
||||
Request.Clear;
|
||||
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]);
|
||||
{$ENDIF}
|
||||
strmResponse.Clear;
|
||||
|
||||
ReadTimeout := 5 * 1000;
|
||||
|
|
|
|||
|
|
@ -1,17 +1,19 @@
|
|||
unit IdIOHandlerWebsocket;
|
||||
|
||||
{.$DEFINE DEBUG_WS}
|
||||
|
||||
//The WebSocket Protocol, RFC 6455
|
||||
//http://datatracker.ietf.org/doc/rfc6455/?include_text=1
|
||||
|
||||
interface
|
||||
|
||||
{$I wsdefines.pas}
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
IdIOHandlerStack, IdGlobal, IdException, IdBuffer,
|
||||
SyncObjs,
|
||||
Generics.Collections;
|
||||
Classes, SysUtils , SyncObjs , Generics.Collections
|
||||
, IdIOHandlerStack
|
||||
, IdGlobal
|
||||
, IdException
|
||||
, IdBuffer
|
||||
{$IFDEF WEBSOCKETSSL}
|
||||
, IdSSLOpenSSL
|
||||
{$ENDIF}
|
||||
;
|
||||
|
||||
type
|
||||
TWSDataType = (wdtText, wdtBinary);
|
||||
|
|
@ -26,7 +28,19 @@ type
|
|||
TIdTextEncoding = IIdTextEncoding;
|
||||
{$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)
|
||||
{$ENDIF}
|
||||
private
|
||||
FIsServerSide: Boolean;
|
||||
FBusyUpgrading: Boolean;
|
||||
|
|
@ -44,9 +58,9 @@ type
|
|||
procedure SetIsWebsocket(const Value: Boolean);
|
||||
protected
|
||||
FMessageStream: TMemoryStream;
|
||||
FWriteTextToTarget: Boolean;
|
||||
FCloseCodeSend: Boolean;
|
||||
FPendingWriteCount: Integer;
|
||||
fPayloadInfo: TIOWSPayloadInfo;
|
||||
|
||||
function InternalReadDataFromSource(var VBuffer: TIdBytes; ARaiseExceptionOnTimeout: Boolean): Integer;
|
||||
function ReadDataFromSource(var VBuffer: TIdBytes): Integer; override;
|
||||
|
|
@ -60,6 +74,7 @@ type
|
|||
{$else}
|
||||
function UTF8Encoding: TEncoding;
|
||||
{$ifend}
|
||||
procedure InitComponent; override;
|
||||
public
|
||||
function WriteData(aData: TIdBytes; aType: TWSDataCode;
|
||||
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 ClientExtensionBits : TWSExtensionBits read FExtensionBits write FExtensionBits;
|
||||
public
|
||||
class constructor Create;
|
||||
procedure AfterConstruction;override;
|
||||
destructor Destroy; override;
|
||||
|
||||
procedure Lock;
|
||||
|
|
@ -229,15 +242,45 @@ begin
|
|||
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 }
|
||||
|
||||
procedure TIdIOHandlerWebsocket.AfterConstruction;
|
||||
procedure TIdIOHandlerWebsocket.InitComponent;
|
||||
begin
|
||||
inherited;
|
||||
inherited ;
|
||||
FMessageStream := TMemoryStream.Create;
|
||||
FWSInputBuffer := TIdBuffer.Create;
|
||||
FLock := TCriticalSection.Create;
|
||||
FSelectLock := TCriticalSection.Create;
|
||||
{$IFDEF WEBSOCKETSSL}
|
||||
//SendBufferSize := 15 * 1024;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
procedure TIdIOHandlerWebsocket.Clear;
|
||||
|
|
@ -253,7 +296,7 @@ begin
|
|||
FCloseCode := 0;
|
||||
FLastActivityTime := 0;
|
||||
FLastPingTime := 0;
|
||||
FWriteTextToTarget := False;
|
||||
fPayloadInfo.Clear;
|
||||
FCloseCodeSend := False;
|
||||
FPendingWriteCount := 0;
|
||||
end;
|
||||
|
|
@ -340,11 +383,6 @@ begin
|
|||
end;
|
||||
end;
|
||||
|
||||
class constructor TIdIOHandlerWebsocket.Create;
|
||||
begin
|
||||
//UseSingleWriteThread := True;
|
||||
end;
|
||||
|
||||
destructor TIdIOHandlerWebsocket.Destroy;
|
||||
begin
|
||||
while FPendingWriteCount > 0 do
|
||||
|
|
@ -400,8 +438,7 @@ begin
|
|||
SetLength(VBuffer, Result);
|
||||
end;
|
||||
|
||||
procedure TIdIOHandlerWebsocket.WriteLn(const AOut: string;
|
||||
AEncoding: TIdTextEncoding);
|
||||
procedure TIdIOHandlerWebsocket.WriteLn(const AOut:string; AEncoding: TIdTextEncoding);
|
||||
begin
|
||||
if UseSingleWriteThread and IsWebsocket and
|
||||
(GetCurrentThreadId <> TIdWebsocketWriteThread.Instance.ThreadID) then
|
||||
|
|
@ -418,10 +455,10 @@ begin
|
|||
begin
|
||||
Lock;
|
||||
try
|
||||
FWriteTextToTarget := True;
|
||||
fPayloadInfo.Initialize(True,0);
|
||||
inherited WriteLn(AOut, UTF8Encoding); //must be UTF8!
|
||||
finally
|
||||
FWriteTextToTarget := False;
|
||||
fPayloadInfo.Clear;
|
||||
Unlock;
|
||||
end;
|
||||
end;
|
||||
|
|
@ -445,10 +482,10 @@ begin
|
|||
begin
|
||||
Lock;
|
||||
try
|
||||
FWriteTextToTarget := True;
|
||||
fPayloadInfo.Initialize(True,0);
|
||||
inherited WriteLnRFC(AOut, UTF8Encoding); //must be UTF8!
|
||||
finally
|
||||
FWriteTextToTarget := False;
|
||||
fPayloadInfo.Clear;
|
||||
Unlock;
|
||||
end;
|
||||
end;
|
||||
|
|
@ -472,10 +509,10 @@ begin
|
|||
begin
|
||||
Lock;
|
||||
try
|
||||
FWriteTextToTarget := True;
|
||||
fPayloadInfo.Initialize(True,0);
|
||||
inherited Write(AOut, UTF8Encoding); //must be UTF8!
|
||||
finally
|
||||
FWriteTextToTarget := False;
|
||||
fPayloadInfo.Clear;
|
||||
Unlock;
|
||||
end;
|
||||
end;
|
||||
|
|
@ -499,10 +536,10 @@ begin
|
|||
begin
|
||||
Lock;
|
||||
try
|
||||
FWriteTextToTarget := True;
|
||||
fPayloadInfo.Initialize(True,0);
|
||||
inherited Write(AValue, AWriteLinesCount, UTF8Encoding); //must be UTF8!
|
||||
finally
|
||||
FWriteTextToTarget := False;
|
||||
fPayloadInfo.Clear;
|
||||
Unlock;
|
||||
end;
|
||||
end;
|
||||
|
|
@ -526,10 +563,10 @@ begin
|
|||
begin
|
||||
Lock;
|
||||
try
|
||||
FWriteTextToTarget := (aType = wdtText);
|
||||
fPayloadInfo.Initialize((aType = wdtText),AStream.Size);
|
||||
inherited Write(AStream);
|
||||
finally
|
||||
FWriteTextToTarget := False;
|
||||
fPayloadInfo.Clear;
|
||||
Unlock;
|
||||
end;
|
||||
end;
|
||||
|
|
@ -554,10 +591,8 @@ begin
|
|||
inherited WriteBufferFlush(AByteCount);
|
||||
end;
|
||||
|
||||
function TIdIOHandlerWebsocket.WriteDataToTarget(const ABuffer: TIdBytes;
|
||||
const AOffset, ALength: Integer): Integer;
|
||||
var
|
||||
data: TIdBytes;
|
||||
function TIdIOHandlerWebsocket.WriteDataToTarget(const ABuffer: TIdBytes; const AOffset, ALength: Integer): Integer;
|
||||
var data: TIdBytes; DataCode:TWSDataCode; fin:boolean;
|
||||
begin
|
||||
if UseSingleWriteThread and IsWebsocket and (GetCurrentThreadId <> TIdWebsocketWriteThread.Instance.ThreadID) then
|
||||
Assert(False, 'Write done in different thread than TIdWebsocketWriteThread!');
|
||||
|
|
@ -584,12 +619,9 @@ begin
|
|||
|
||||
{$ENDIF}
|
||||
try
|
||||
if FWriteTextToTarget then
|
||||
Result := WriteData(data, wdcText, True{send all at once},
|
||||
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);
|
||||
DataCode := fPayloadInfo.aDataCode;
|
||||
fin := fPayloadInfo.DecLength(ALength);
|
||||
Result := WriteData(data, DataCode, fin,webBit1 in ClientExtensionBits, webBit2 in ClientExtensionBits, webBit3 in ClientExtensionBits);
|
||||
except
|
||||
FClosedGracefully := True;
|
||||
Result := -1;
|
||||
|
|
@ -853,7 +885,7 @@ var
|
|||
temp: TIdBytes;
|
||||
begin
|
||||
//if HasData then Exit(True);
|
||||
if (FWSInputBuffer.Size > 0) then Exit(True);
|
||||
if (FWSInputBuffer.Size > iInputPos) then Exit(True);
|
||||
|
||||
Result := InternalReadDataFromSource(temp, ARaiseExceptionOnTimeout) > 0;
|
||||
if Result then
|
||||
|
|
@ -1019,8 +1051,7 @@ begin
|
|||
{$ENDIF}
|
||||
end;
|
||||
|
||||
function TIdIOHandlerWebsocket.WriteData(aData: TIdBytes;
|
||||
aType: TWSDataCode; aFIN, aRSV1, aRSV2, aRSV3: boolean): integer;
|
||||
function TIdIOHandlerWebsocket.WriteData(aData:TIdBytes; aType:TWSDataCode; aFIN,aRSV1,aRSV2,aRSV3:boolean): integer;
|
||||
var
|
||||
iByte: Byte;
|
||||
i, ioffset: NativeInt;
|
||||
|
|
@ -1051,7 +1082,7 @@ begin
|
|||
| |1|2|3| |K| | |
|
||||
+-+-+-+-+-------+-+-------------+ - - - - - - - - - - - - - - - + *)
|
||||
//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 aRSV2 then iByte := iByte + (1 shl 5);
|
||||
if aRSV3 then iByte := iByte + (1 shl 4);
|
||||
|
|
@ -1137,7 +1168,17 @@ begin
|
|||
ioffset := 0;
|
||||
repeat
|
||||
//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);
|
||||
until ioffset >= Length(bData);
|
||||
|
||||
|
|
|
|||
|
|
@ -1,16 +1,33 @@
|
|||
unit IdServerIOHandlerWebsocket;
|
||||
|
||||
interface
|
||||
|
||||
{$I wsdefines.pas}
|
||||
uses
|
||||
Classes,
|
||||
IdServerIOHandlerStack, IdIOHandlerStack, IdGlobal, IdIOHandler, IdYarn, IdThread, IdSocketHandle,
|
||||
IdIOHandlerWebsocket;
|
||||
Classes
|
||||
, IdServerIOHandlerStack
|
||||
, IdIOHandlerStack
|
||||
, IdGlobal
|
||||
, IdIOHandler
|
||||
, IdYarn
|
||||
, IdThread
|
||||
, IdSocketHandle
|
||||
//
|
||||
, IdIOHandlerWebsocket
|
||||
{$IFDEF WEBSOCKETSSL}
|
||||
, IdSSLOpenSSL
|
||||
{$ENDIF}
|
||||
;
|
||||
|
||||
type
|
||||
{$IFDEF WEBSOCKETSSL}
|
||||
TIdServerIOHandlerWebsocket = class(TIdServerIOHandlerSSLOpenSSL)
|
||||
{$ELSE}
|
||||
TIdServerIOHandlerWebsocket = class(TIdServerIOHandlerStack)
|
||||
{$ENDIF}
|
||||
protected
|
||||
procedure InitComponent; override;
|
||||
{$IFDEF WEBSOCKETSSL}
|
||||
function CreateOpenSSLSocket:TIdSSLIOHandlerSocketOpenSSL; override;
|
||||
{$ENDIF}
|
||||
public
|
||||
function Accept(ASocket: TIdSocketHandle; AListenerThread: TIdThread;
|
||||
AYarn: TIdYarn): TIdIOHandler; override;
|
||||
|
|
@ -21,6 +38,13 @@ implementation
|
|||
|
||||
{ TIdServerIOHandlerStack_Websocket }
|
||||
|
||||
{$IFDEF WEBSOCKETSSL}
|
||||
function TIdServerIOHandlerWebsocket.CreateOpenSSLSocket:TIdSSLIOHandlerSocketOpenSSL;
|
||||
begin
|
||||
Result := TIdIOHandlerWebsocket.Create(nil);
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
function TIdServerIOHandlerWebsocket.Accept(ASocket: TIdSocketHandle;
|
||||
AListenerThread: TIdThread; AYarn: TIdYarn): TIdIOHandler;
|
||||
begin
|
||||
|
|
@ -35,18 +59,22 @@ end;
|
|||
procedure TIdServerIOHandlerWebsocket.InitComponent;
|
||||
begin
|
||||
inherited InitComponent;
|
||||
{$IFNDEF WEBSOCKETSSL}
|
||||
IOHandlerSocketClass := TIdIOHandlerWebsocket;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
function TIdServerIOHandlerWebsocket.MakeClientIOHandler(
|
||||
ATheThread: TIdYarn): TIdIOHandler;
|
||||
begin
|
||||
Result := inherited MakeClientIOHandler(ATheThread);
|
||||
{$IFNDEF WEBSOCKETSSL}
|
||||
if Result <> nil then
|
||||
begin
|
||||
(Result as TIdIOHandlerWebsocket).IsServerSide := True; //server must not mask, only client
|
||||
(Result as TIdIOHandlerWebsocket).UseNagle := False;
|
||||
end;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
end.
|
||||
|
|
|
|||
|
|
@ -1,12 +1,18 @@
|
|||
unit IdServerSocketIOHandling;
|
||||
|
||||
interface
|
||||
|
||||
{$I wsdefines.pas}
|
||||
uses
|
||||
IdContext, IdCustomTCPServer,
|
||||
//IdServerWebsocketContext,
|
||||
Classes, Generics.Collections,
|
||||
superobject, IdException, IdServerBaseHandling, IdSocketIOHandling;
|
||||
Classes, Generics.Collections, SysUtils, StrUtils
|
||||
, IdContext
|
||||
, IdCustomTCPServer
|
||||
, IdException
|
||||
//
|
||||
{$IFDEF SUPEROBJECT}
|
||||
, superobject
|
||||
{$ENDIF}
|
||||
, IdServerBaseHandling
|
||||
, IdSocketIOHandling
|
||||
;
|
||||
|
||||
type
|
||||
TIdServerSocketIOHandling = class(TIdBaseSocketIOHandling)
|
||||
|
|
@ -15,22 +21,27 @@ type
|
|||
public
|
||||
function SendToAll(const aMessage: string; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil): Integer;
|
||||
procedure SendTo (const aContext: TIdServerContext; const aMessage: string; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);
|
||||
|
||||
function EmitEventToAll(const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; 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;
|
||||
const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);overload;
|
||||
{$IFDEF SUPEROBJECT}
|
||||
function EmitEventToAll(const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil): Integer;overload;
|
||||
procedure EmitEventTo (const aContext: TIdServerContext;
|
||||
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;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
SysUtils, StrUtils;
|
||||
|
||||
{ TIdServerSocketIOHandling }
|
||||
|
||||
procedure TIdServerSocketIOHandling.ProcessHeatbeatRequest(
|
||||
const AContext: ISocketIOContext; const aText: string);
|
||||
begin
|
||||
inherited ProcessHeatbeatRequest(AContext, aText);
|
||||
end;
|
||||
|
||||
{$IFDEF SUPEROBJECT}
|
||||
procedure TIdServerSocketIOHandling.EmitEventTo(
|
||||
const aContext: ISocketIOContext; const aEventName: string;
|
||||
const aData: ISuperObject; const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
|
||||
|
|
@ -72,6 +83,16 @@ begin
|
|||
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,
|
||||
aData: string; const aCallback: TSocketIOMsgJSON;
|
||||
const aOnError: TSocketIOError): Integer;
|
||||
|
|
@ -125,21 +146,6 @@ begin
|
|||
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;
|
||||
const aMessage: string; const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
|
||||
var
|
||||
|
|
|
|||
|
|
@ -1,16 +1,22 @@
|
|||
unit IdServerWebsocketContext;
|
||||
|
||||
interface
|
||||
|
||||
{$I wsdefines.pas}
|
||||
uses
|
||||
Classes,
|
||||
IdCustomTCPServer, IdIOHandlerWebsocket,
|
||||
IdServerBaseHandling, IdServerSocketIOHandling, IdContext;
|
||||
Classes, strUtils
|
||||
, IdContext
|
||||
, IdCustomTCPServer
|
||||
, IdCustomHTTPServer
|
||||
//
|
||||
, IdIOHandlerWebsocket
|
||||
, IdServerBaseHandling
|
||||
, IdServerSocketIOHandling
|
||||
;
|
||||
|
||||
type
|
||||
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)
|
||||
private
|
||||
|
|
@ -25,6 +31,7 @@ type
|
|||
FWebSocketExtensions: string;
|
||||
FCookie: string;
|
||||
//FSocketIOPingSend: Boolean;
|
||||
fOnWebSocketUpgrade: TWebSocketUpgradeEvent;
|
||||
FOnCustomChannelExecute: TWebsocketChannelRequest;
|
||||
FSocketIO: TIdServerSocketIOHandling;
|
||||
FOnDestroy: TIdContextEvent;
|
||||
|
|
@ -50,14 +57,12 @@ type
|
|||
property WebSocketVersion : Integer read FWebSocketVersion write FWebSocketVersion;
|
||||
property WebSocketExtensions: string read FWebSocketExtensions write FWebSocketExtensions;
|
||||
public
|
||||
property OnWebSocketUpgrade: TWebsocketUpgradeEvent read FOnWebSocketUpgrade write FOnWebSocketUpgrade;
|
||||
property OnCustomChannelExecute: TWebsocketChannelRequest read FOnCustomChannelExecute write FOnCustomChannelExecute;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
StrUtils;
|
||||
|
||||
{ TIdServerWSContext }
|
||||
|
||||
destructor TIdServerWSContext.Destroy;
|
||||
|
|
|
|||
|
|
@ -1,16 +1,24 @@
|
|||
unit IdServerWebsocketHandling;
|
||||
|
||||
interface
|
||||
|
||||
{$I wsdefines.pas}
|
||||
uses
|
||||
IdContext, IdCustomHTTPServer,
|
||||
Classes, StrUtils, SysUtils, DateUtils
|
||||
, IdCoderMIME
|
||||
, IdThread
|
||||
, IdContext
|
||||
, IdCustomHTTPServer
|
||||
{$IF CompilerVersion <= 21.0} //D2010
|
||||
IdHashSHA1,
|
||||
, IdHashSHA1
|
||||
{$else}
|
||||
IdHashSHA, //XE3 etc
|
||||
, IdHashSHA //XE3 etc
|
||||
{$IFEND}
|
||||
IdServerSocketIOHandling, IdServerWebsocketContext,
|
||||
Classes, IdServerBaseHandling, IdIOHandlerWebsocket, IdSocketIOHandling;
|
||||
, IdServerSocketIOHandling
|
||||
//
|
||||
, IdSocketIOHandling
|
||||
, IdServerBaseHandling
|
||||
, IdServerWebsocketContext
|
||||
, IdIOHandlerWebsocket
|
||||
;
|
||||
|
||||
type
|
||||
TIdServerSocketIOHandling_Ext = class(TIdServerSocketIOHandling)
|
||||
|
|
@ -19,7 +27,7 @@ type
|
|||
TIdServerWebsocketHandling = class(TIdServerBaseHandling)
|
||||
protected
|
||||
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;
|
||||
aSocketIOHandler: TIdServerSocketIOHandling_Ext);virtual;
|
||||
public
|
||||
|
|
@ -31,10 +39,6 @@ type
|
|||
|
||||
implementation
|
||||
|
||||
uses
|
||||
StrUtils, SysUtils, DateUtils,
|
||||
IdCustomTCPServer, IdCoderMIME, IdThread;
|
||||
|
||||
{ TIdServerWebsocketHandling }
|
||||
|
||||
class function TIdServerWebsocketHandling.CurrentSocket: ISocketIOContext;
|
||||
|
|
@ -103,23 +107,20 @@ begin
|
|||
Continue;
|
||||
end;
|
||||
|
||||
if wscode = wdcText then
|
||||
wstype := wdtText
|
||||
else
|
||||
wstype := wdtBinary;
|
||||
if wscode = wdcText
|
||||
then wstype := wdtText
|
||||
else wstype := wdtBinary;
|
||||
|
||||
HandleWSMessage(context, wstype, strmRequest, strmResponse, aSocketIOHandler);
|
||||
|
||||
//write result back (of the same type: text or bin)
|
||||
if strmResponse.Size > 0 then
|
||||
begin
|
||||
if wscode = wdcText then
|
||||
context.IOHandler.Write(strmResponse, wdtText)
|
||||
else
|
||||
context.IOHandler.Write(strmResponse, wdtBinary)
|
||||
if wstype = wdtText
|
||||
then context.IOHandler.Write(strmResponse, wdtText)
|
||||
else context.IOHandler.Write(strmResponse, wdtBinary)
|
||||
end
|
||||
else
|
||||
context.IOHandler.WriteData(nil, wdcPing);
|
||||
else context.IOHandler.WriteData(nil, wdcPing);
|
||||
finally
|
||||
strmRequest.Free;
|
||||
strmResponse.Free;
|
||||
|
|
@ -152,9 +153,7 @@ begin
|
|||
end;
|
||||
end;
|
||||
|
||||
class procedure TIdServerWebsocketHandling.HandleWSMessage(AContext: TIdServerWSContext; aType: TWSDataType;
|
||||
aRequestStrm, aResponseStrm: TMemoryStream;
|
||||
aSocketIOHandler: TIdServerSocketIOHandling_Ext);
|
||||
class procedure TIdServerWebsocketHandling.HandleWSMessage(AContext: TIdServerWSContext; var aType:TWSDataType; aRequestStrm, aResponseStrm: TMemoryStream; aSocketIOHandler: TIdServerSocketIOHandling_Ext);
|
||||
begin
|
||||
if AContext.IsSocketIO then
|
||||
begin
|
||||
|
|
@ -170,6 +169,7 @@ class function TIdServerWebsocketHandling.ProcessServerCommandGet(
|
|||
AThread: TIdServerWSContext; ARequestInfo: TIdHTTPRequestInfo;
|
||||
AResponseInfo: TIdHTTPResponseInfo): Boolean;
|
||||
var
|
||||
Accept: Boolean;
|
||||
sValue, squid: string;
|
||||
context: TIdServerWSContext;
|
||||
hash: TIdHashSHA1;
|
||||
|
|
@ -244,6 +244,13 @@ begin
|
|||
Result := True; //handled
|
||||
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==
|
||||
sValue := ARequestInfo.RawHeaders.Values['sec-websocket-key'];
|
||||
//"The value of this header field MUST be a nonce consisting of a randomly
|
||||
|
|
|
|||
|
|
@ -1,14 +1,24 @@
|
|||
unit IdSocketIOHandling;
|
||||
|
||||
interface
|
||||
|
||||
{$I wsdefines.pas}
|
||||
uses
|
||||
Classes, Generics.Collections,
|
||||
superobject,
|
||||
IdServerBaseHandling, IdContext, IdException, IdIOHandlerWebsocket, IdHTTP,
|
||||
SyncObjs, SysUtils;
|
||||
windows, SyncObjs, SysUtils, StrUtils, Classes, Generics.Collections
|
||||
{$IFDEF SUPEROBJECT}
|
||||
, superobject
|
||||
{$ENDIF}
|
||||
, IdContext
|
||||
, IdException
|
||||
, IdHTTP
|
||||
//
|
||||
, IdServerBaseHandling
|
||||
, IdIOHandlerWebsocket
|
||||
;
|
||||
|
||||
type
|
||||
{$IFNDEF SUPEROBJECT}
|
||||
TSuperArray = String;
|
||||
{$ENDIF}
|
||||
|
||||
TSocketIOContext = class;
|
||||
TSocketIOCallbackObj = class;
|
||||
TIdBaseSocketIOHandling = class;
|
||||
|
|
@ -18,9 +28,13 @@ type
|
|||
ISocketIOCallback = interface;
|
||||
|
||||
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);
|
||||
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);
|
||||
TSocketIONotify = reference to procedure(const ASocket: ISocketIOContext);
|
||||
TSocketIOError = reference to procedure(const ASocket: ISocketIOContext; const aErrorClass, aErrorMessage: string);
|
||||
TSocketIOEventError = reference to procedure(const ASocket: ISocketIOContext; const aCallback: ISocketIOCallback; E: Exception);
|
||||
|
||||
|
|
@ -48,14 +62,15 @@ type
|
|||
|
||||
function IsDisconnected: Boolean;
|
||||
|
||||
{$IFDEF SUPEROBJECT}
|
||||
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 Send(const aData: string; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);
|
||||
procedure SendJSON(const aJSON: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);
|
||||
end;
|
||||
|
||||
TSocketIOContext = class(TInterfacedObject,
|
||||
ISocketIOContext)
|
||||
TSocketIOContext = class(TInterfacedObject,ISocketIOContext)
|
||||
private
|
||||
FLock: TCriticalSection;
|
||||
FPingSend: Boolean;
|
||||
|
|
@ -104,14 +119,15 @@ type
|
|||
property CustomData: TObject read GetCustomData write SetCustomData;
|
||||
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: 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; 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);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
ISocketIOCallback = interface
|
||||
|
|
@ -137,7 +153,9 @@ type
|
|||
protected
|
||||
Done, Success: Boolean;
|
||||
Error: Exception;
|
||||
{$IFDEF SUPEROBJECT}
|
||||
Data : ISuperObject;
|
||||
{$ENDIF}
|
||||
Event: TEvent;
|
||||
public
|
||||
procedure AfterConstruction; override;
|
||||
|
|
@ -158,7 +176,9 @@ type
|
|||
FOnDisconnectList: TSocketIONotifyList;
|
||||
FOnEventList: TObjectDictionary<string,TSocketIOEventList>;
|
||||
FOnSocketIOMsg: TSocketIOMsg;
|
||||
{$IFDEF SUPEROBJECT}
|
||||
FOnSocketIOJson: TSocketIOMsgJSON;
|
||||
{$ENDIF}
|
||||
|
||||
procedure ProcessEvent(const AContext: ISocketIOContext; const aText: string; aMsgNr: Integer; aHasCallback: Boolean);
|
||||
private
|
||||
|
|
@ -186,7 +206,9 @@ type
|
|||
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 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;
|
||||
{$ENDIF}
|
||||
procedure WriteSocketIOResult(const ASocket: ISocketIOContext; aRequestMsgNr: Integer; const aRoom, aData: string);
|
||||
|
||||
procedure ProcessSocketIO_XHR(const aGUID: string; const aStrmRequest, aStrmResponse: TStream);
|
||||
|
|
@ -215,7 +237,9 @@ type
|
|||
procedure FreeConnection(const ASocket: ISocketIOContext);overload;
|
||||
|
||||
property OnSocketIOMsg : TSocketIOMsg read FOnSocketIOMsg write FOnSocketIOMsg;
|
||||
{$IFDEF SUPEROBJECT}
|
||||
property OnSocketIOJson : TSocketIOMsgJSON read FOnSocketIOJson write FOnSocketIOJson;
|
||||
{$ENDIF}
|
||||
|
||||
procedure OnEvent (const aEventName: string; const aCallback: TSocketIOEvent);
|
||||
procedure OnConnection(const aCallback: TSocketIONotify);
|
||||
|
|
@ -228,15 +252,29 @@ type
|
|||
TIdSocketIOHandling = class(TIdBaseSocketIOHandling)
|
||||
public
|
||||
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;
|
||||
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;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
{$IFNDEF SUPEROBJECT}
|
||||
function SO(const S:string):string; inline;
|
||||
{$ENDIF}
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
StrUtils, IdServerWebsocketContext, IdHTTPWebsocketClient, Windows;
|
||||
IdServerWebsocketContext, IdHTTPWebsocketClient;
|
||||
|
||||
{$IFNDEF SUPEROBJECT}
|
||||
function SO(const S:string):string; inline;
|
||||
begin
|
||||
Result := S;
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
procedure TIdBaseSocketIOHandling.AfterConstruction;
|
||||
begin
|
||||
|
|
@ -502,8 +540,7 @@ begin
|
|||
FOnDisconnectList.Add(aCallback);
|
||||
end;
|
||||
|
||||
procedure TIdBaseSocketIOHandling.OnEvent(const aEventName: string;
|
||||
const aCallback: TSocketIOEvent);
|
||||
procedure TIdBaseSocketIOHandling.OnEvent(const aEventName: string; const aCallback: TSocketIOEvent);
|
||||
var list: TSocketIOEventList;
|
||||
begin
|
||||
if not FOnEventList.TryGetValue(aEventName, list) then
|
||||
|
|
@ -523,26 +560,86 @@ begin
|
|||
TSocketIOContext(ASocket).FContext.Connection.Disconnect;
|
||||
end;
|
||||
|
||||
procedure TIdBaseSocketIOHandling.ProcessEvent(
|
||||
const AContext: ISocketIOContext; const aText: string; aMsgNr: Integer;
|
||||
aHasCallback: Boolean);
|
||||
procedure TIdBaseSocketIOHandling.ProcessEvent(const AContext: ISocketIOContext; const aText: string; aMsgNr: Integer;aHasCallback: Boolean);
|
||||
var
|
||||
json: ISuperObject;
|
||||
name: string;
|
||||
{$IFNDEF SUPEROBJECT}
|
||||
args: string;
|
||||
{$ELSE}
|
||||
args: TSuperArray;
|
||||
json: ISuperObject;
|
||||
// socket: TSocketIOContext;
|
||||
{$ENDIF}
|
||||
list: TSocketIOEventList;
|
||||
event: TSocketIOEvent;
|
||||
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
|
||||
//'5:' [message id ('+')] ':' [message endpoint] ':' [json encoded event]
|
||||
//5::/chat:{"name":"my other event","args":[{"my":"data"}]}
|
||||
//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);
|
||||
// args := nil;
|
||||
// args := nil;
|
||||
try
|
||||
name := json.S['name']; //"my other event
|
||||
args := json.A['args']; //[{"my":"data"}]
|
||||
{$ENDIF}
|
||||
|
||||
if FOnEventList.TryGetValue(name, list) then
|
||||
begin
|
||||
|
|
@ -563,7 +660,11 @@ begin
|
|||
OnEventError(AContext, callback, e)
|
||||
else
|
||||
if callback <> nil then
|
||||
{$IFNDEF SUPEROBJECT}
|
||||
callback.SendResponse('Error');
|
||||
{$ELSE}
|
||||
callback.SendResponse( SO(['Error', SO(['msg', e.message])]).AsJSon );
|
||||
{$ENDIF}
|
||||
end;
|
||||
finally
|
||||
callback := nil;
|
||||
|
|
@ -571,10 +672,13 @@ begin
|
|||
end
|
||||
else
|
||||
raise EIdSocketIoUnhandledMessage.Create(aText);
|
||||
|
||||
{$IFDEF SUPEROBJECT}
|
||||
finally
|
||||
// args.Free;
|
||||
json := nil;
|
||||
//args.Free;
|
||||
json := nil;
|
||||
end;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
procedure TIdBaseSocketIOHandling.ProcessHeatbeatRequest(const ASocket: ISocketIOContext; const aText: string);
|
||||
|
|
@ -749,7 +853,9 @@ var
|
|||
callbackref: TSocketIOCallbackRef;
|
||||
callbackobj: ISocketIOCallback;
|
||||
errorref: TSocketIOError;
|
||||
{$IFDEF SUPEROBJECT}
|
||||
error: ISuperObject;
|
||||
{$ENDIF}
|
||||
socket: TSocketIOContext;
|
||||
begin
|
||||
if ASocket = nil then Exit;
|
||||
|
|
@ -822,8 +928,12 @@ begin
|
|||
except
|
||||
on E:Exception do
|
||||
begin
|
||||
{$IFDEF SUPEROBJECT}
|
||||
if not callbackobj.IsResponseSend then
|
||||
callbackobj.SendResponse( SO(['Error', SO(['Type', e.ClassName, 'Message', e.Message])]).AsJSon );
|
||||
{$ELSE}
|
||||
//TODO
|
||||
{$ENDIF}
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
|
|
@ -841,6 +951,7 @@ begin
|
|||
//4:1::{"a":"b"}
|
||||
else if StartsStr('4:', str) then
|
||||
begin
|
||||
{$IFDEF SUPEROBJECT}
|
||||
if Assigned(OnSocketIOJson) then
|
||||
begin
|
||||
if bCallback then
|
||||
|
|
@ -864,6 +975,7 @@ begin
|
|||
OnSocketIOJson(ASocket, SO(sdata), nil); //, imsg, bCallback);
|
||||
end
|
||||
else
|
||||
{$ENDIF}
|
||||
raise EIdSocketIoUnhandledMessage.Create(str);
|
||||
end
|
||||
//(5) Event
|
||||
|
|
@ -895,6 +1007,7 @@ begin
|
|||
begin
|
||||
FSocketIOErrorRef.Remove(imsg);
|
||||
//'[{"Error":{"Message":"Operation aborted","Type":"EAbort"}}]'
|
||||
{$IFDEF SUPEROBJECT}
|
||||
if ContainsText(sdata, '{"Error":') then
|
||||
begin
|
||||
error := SO(sdata);
|
||||
|
|
@ -910,6 +1023,7 @@ begin
|
|||
FSocketIOEventCallbackRef.Remove(imsg);
|
||||
Exit;
|
||||
end;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
if FSocketIOEventCallback.TryGetValue(imsg, callback) then
|
||||
|
|
@ -1049,6 +1163,7 @@ begin
|
|||
WriteString(ASocket, sresult);
|
||||
end;
|
||||
|
||||
{$IFDEF SUPEROBJECT}
|
||||
function TIdBaseSocketIOHandling.WriteSocketIOEventSync(const ASocket: ISocketIOContext; const aRoom, aEventName,
|
||||
aJSONArray: string; aMaxwait_ms: Cardinal = INFINITE): ISuperObject;
|
||||
var
|
||||
|
|
@ -1133,7 +1248,7 @@ begin
|
|||
promise.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
{$ENDIF}
|
||||
procedure TIdBaseSocketIOHandling.WriteSocketIOJSON(const ASocket: ISocketIOContext;
|
||||
const aRoom, aJSON: string; aCallback: TSocketIOCallbackRef = nil; const aOnError: TSocketIOError = nil);
|
||||
var
|
||||
|
|
@ -1290,8 +1405,7 @@ begin
|
|||
inherited;
|
||||
end;
|
||||
|
||||
procedure TSocketIOContext.EmitEvent(const aEventName, aData: string;
|
||||
const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
|
||||
procedure TSocketIOContext.EmitEvent(const aEventName, aData: string; const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
|
||||
begin
|
||||
Assert(FHandling <> nil);
|
||||
|
||||
|
|
@ -1307,14 +1421,15 @@ begin
|
|||
end;
|
||||
end;
|
||||
|
||||
procedure TSocketIOContext.EmitEvent(const aEventName: string; const aData: ISuperObject;
|
||||
const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
|
||||
{$IFDEF SUPEROBJECT}
|
||||
procedure TSocketIOContext.EmitEvent(const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
|
||||
begin
|
||||
if aData <> nil then
|
||||
EmitEvent(aEventName, aData.AsJSon, aCallback, aOnError)
|
||||
else
|
||||
EmitEvent(aEventName, '', aCallback, aOnError);
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
function TSocketIOContext.GetCustomData: TObject;
|
||||
begin
|
||||
|
|
@ -1383,8 +1498,7 @@ begin
|
|||
Result := (FClient as TIdHTTPWebsocketClient).WSResourceName
|
||||
end;
|
||||
|
||||
procedure TSocketIOContext.Send(const aData: string;
|
||||
const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
|
||||
procedure TSocketIOContext.Send(const aData: string; const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
|
||||
begin
|
||||
if not Assigned(aCallback) then
|
||||
FHandling.WriteSocketIOMsg(Self, '', aData)
|
||||
|
|
@ -1398,6 +1512,7 @@ begin
|
|||
end;
|
||||
end;
|
||||
|
||||
{$IFDEF SUPEROBJECT}
|
||||
procedure TSocketIOContext.SendJSON(const aJSON: ISuperObject;
|
||||
const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
|
||||
begin
|
||||
|
|
@ -1412,7 +1527,7 @@ begin
|
|||
end, aOnError);
|
||||
end;
|
||||
end;
|
||||
|
||||
{$ENDIF}
|
||||
procedure TSocketIOContext.ServerContextDestroy(AContext: TIdContext);
|
||||
begin
|
||||
Self.Context := nil;
|
||||
|
|
@ -1521,6 +1636,7 @@ end;
|
|||
|
||||
{ TIdSocketIOHandling }
|
||||
|
||||
{$IFDEF SUPEROBJECT}
|
||||
procedure TIdSocketIOHandling.Emit(const aEventName: string;
|
||||
const aData: ISuperObject; const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
|
||||
var
|
||||
|
|
@ -1621,6 +1737,52 @@ begin
|
|||
|
||||
Result := WriteSocketIOEventSync(firstcontext, ''{no room}, aEventName, jsonarray, aMaxwait_ms);
|
||||
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;
|
||||
const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
|
||||
|
|
@ -1669,6 +1831,7 @@ begin
|
|||
end;
|
||||
end;
|
||||
|
||||
|
||||
{ TSocketIOPromise }
|
||||
|
||||
procedure TSocketIOPromise.AfterConstruction;
|
||||
|
|
|
|||
|
|
@ -1,16 +1,41 @@
|
|||
unit IdWebsocketServer;
|
||||
|
||||
interface
|
||||
|
||||
{$I wsdefines.pas}
|
||||
uses
|
||||
IdServerWebsocketHandling, IdServerSocketIOHandling, IdServerWebsocketContext,
|
||||
IdHTTPServer, IdContext, IdCustomHTTPServer, Classes, IdIOHandlerWebsocket;
|
||||
Classes
|
||||
, IdStreamVCL
|
||||
, IdGlobal
|
||||
, IdWinsock2
|
||||
, IdHTTPServer
|
||||
, IdContext
|
||||
, IdCustomHTTPServer
|
||||
, IdHTTPWebBrokerBridge
|
||||
//
|
||||
, IdIOHandlerWebsocket
|
||||
, IdServerIOHandlerWebsocket
|
||||
, IdServerWebsocketContext
|
||||
, IdServerWebsocketHandling
|
||||
, IdServerSocketIOHandling
|
||||
;
|
||||
|
||||
type
|
||||
TWebsocketMessageText = procedure(const AContext: TIdServerWSContext; const aText: string) 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)
|
||||
{$ENDIF}
|
||||
private
|
||||
FSocketIO: TIdServerSocketIOHandling_Ext;
|
||||
FOnMessageText: TWebsocketMessageText;
|
||||
|
|
@ -19,12 +44,13 @@ type
|
|||
function GetSocketIO: TIdServerSocketIOHandling;
|
||||
procedure SetWriteTimeout(const Value: Integer);
|
||||
protected
|
||||
procedure DoCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo;
|
||||
AResponseInfo: TIdHTTPResponseInfo); override;
|
||||
function WebSocketCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo):boolean;
|
||||
procedure DoCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); override;
|
||||
procedure ContextCreated(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
|
||||
procedure AfterConstruction; override;
|
||||
destructor Destroy; override;
|
||||
|
|
@ -42,9 +68,6 @@ type
|
|||
|
||||
implementation
|
||||
|
||||
uses
|
||||
IdServerIOHandlerWebsocket, IdStreamVCL, IdGlobal, Windows, IdWinsock2;
|
||||
|
||||
{ TIdWebsocketServer }
|
||||
|
||||
procedure TIdWebsocketServer.AfterConstruction;
|
||||
|
|
@ -82,13 +105,20 @@ begin
|
|||
FSocketIO.Free;
|
||||
end;
|
||||
|
||||
procedure TIdWebsocketServer.DoCommandGet(AContext: TIdContext;
|
||||
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
|
||||
function TIdWebsocketServer.WebSocketCommandGet(AContext: TIdContext;
|
||||
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo):boolean;
|
||||
begin
|
||||
(AContext as TIdServerWSContext).OnWebSocketUpgrade := Self.WebSocketUpgradeRequest;
|
||||
(AContext as TIdServerWSContext).OnCustomChannelExecute := Self.WebsocketChannelRequest;
|
||||
(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);
|
||||
end;
|
||||
|
||||
|
|
@ -124,9 +154,12 @@ begin
|
|||
FWriteTimeout := Value;
|
||||
end;
|
||||
|
||||
procedure TIdWebsocketServer.WebsocketChannelRequest(
|
||||
const AContext: TIdServerWSContext; aType: TWSDataType; const aStrmRequest,
|
||||
aStrmResponse: TMemoryStream);
|
||||
procedure TIdWebsocketServer.WebsocketUpgradeRequest(const AContext: TIdServerWSContext; ARequestInfo: TIdHTTPRequestInfo; var Accept:boolean);
|
||||
begin
|
||||
Accept := True;
|
||||
end;
|
||||
|
||||
procedure TIdWebsocketServer.WebsocketChannelRequest(const AContext: TIdServerWSContext; var aType:TWSDataType; const aStrmRequest,aStrmResponse: TMemoryStream);
|
||||
var s: string;
|
||||
begin
|
||||
if aType = wdtText then
|
||||
|
|
|
|||
Loading…
Reference in New Issue