Compare commits

...

10 commits

Author SHA1 Message Date
André Mussche
d205bbe0a7
Update README.md 2018-01-05 08:19:18 +01:00
André Mussche
de7dc5815c Merge pull request #13 from syfre/master
Missing file
2016-11-11 12:35:20 +01:00
sage-syfre
5cab56c67e Missing file 2016-11-11 08:32:22 +01:00
André Mussche
ca778a3ef5 Merge pull request #12 from syfre/master
* Add defines for supporting SSL and HTTPBridge and removing SUPEROBJ…
2016-11-10 13:13:58 +01:00
Administrator
af28e64043 undo ivy71 pull, merge and resolve conflict with other pull later 2016-11-10 13:11:47 +01:00
André Mussche
f3268769c3 Merge pull request #4 from Yvi71/master
openssl support. tested. worked.
2016-11-10 12:55:31 +01:00
sage-syfre
cdffdd25e1 * 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
2016-10-28 09:20:11 +02:00
Yvi71
803bce2cf3 Fixed some issues with the compiler switch and other things i messed up last night.
Fixed some issues with the compiler switch and other things i messed up
last night
2015-11-13 11:09:24 +01:00
Yvi71
8c88e1704e Merge remote-tracking branch 'refs/remotes/origin/openssl' 2015-11-13 10:42:49 +01:00
yvi71
61cefd77e0 added support for openssl - and therewith dependency to openssl units.
Disable ssl support (and additional dependencies) set the compiler swith 
WS_NO_SSL
2015-11-13 01:59:22 +01:00
12 changed files with 467 additions and 180 deletions

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

@ -1,3 +1,10 @@
# Not active anymore
Unfortunately I don't have time to support this project anymore. Also the websocket protocol has changed in the meantime, so it won't work with browser and other modern implementations.
Please take a look at the free (but closed) 3rd party component:
* http://www.esegece.com/websockets/download
* http://www.esegece.com/download/sgcWebSockets_free.zip
# DelphiWebsockets
Websockets and Socket.io for Delphi

3
wsdefines.pas Normal file
View file

@ -0,0 +1,3 @@
{ $DEFINE WEBSOCKETSSL}
{ $DEFINE WEBSOCKETBRIDGE}
{$DEFINE SUPEROBJECT}