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

Compare commits

base: cmueller:master
Branches Tags
cmueller:master
cmueller:master-Yvi71-pull
cmueller:main-SSL-support
..
compare: cmueller:main-SSL-support
Branches Tags
cmueller:master
cmueller:master-Yvi71-pull
cmueller:main-SSL-support

2 commits
master ... main-SSL-s

Author SHA1 Message Date
Administrator
ffc090df44 better error handling, added DefaultErrorCallback 2015-11-16 10:45:56 +01:00
Administrator
69d3f52ab4 SSL support (seperated websocket implementation from IOHandler to an proxy object) 2015-11-16 10:44:39 +01:00
12 changed files with 917 additions and 1040 deletions
Show stats Expand all files Collapse all files

2
DUnit/UnitTestWebsockets.dpr
View file

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

14
DUnit/mtTestWebSockets.pas
View file

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

561
IdHTTPWebsocketClient.pas
View file

@ -1,15 +1,25 @@
unit IdHTTPWebsocketClient; unit IdHTTPWebsocketClient;
interface interface
{$I wsdefines.pas}
uses uses
Classes, Classes,
IdHTTP, IdHTTP,
{$IF CompilerVersion <= 21.0} //D2010
IdHashSHA1,
{$else}
Types, Types,
IdHashSHA, //XE3 etc IdHashSHA, //XE3 etc
{$IFEND}
IdIOHandler, IdIOHandler,
IdIOHandlerWebsocket, IdIOHandlerWebsocket,
// {$ifdef FMX}
// FMX.Types,
// {$ELSE}
// ExtCtrls,
// {$ENDIF}
IdWinsock2, Generics.Collections, SyncObjs, IdWinsock2, Generics.Collections, SyncObjs,
IdSocketIOHandling; IdSocketIOHandling, IdIOHandlerStack;
type type
TWebsocketMsgBin = procedure(const aData: TStream) of object; TWebsocketMsgBin = procedure(const aData: TStream) of object;
@ -29,11 +39,14 @@ type
FOnTextData: TWebsocketMsgText; FOnTextData: TWebsocketMsgText;
FNoAsyncRead: Boolean; FNoAsyncRead: Boolean;
FWriteTimeout: Integer; FWriteTimeout: Integer;
function GetIOHandlerWS: TIdIOHandlerWebsocket; FUseSSL: boolean;
procedure SetIOHandlerWS(const Value: TIdIOHandlerWebsocket); FWebsocketImpl: TWebsocketImplementationProxy;
function GetIOHandlerWS: TWebsocketImplementationProxy;
procedure SetOnData(const Value: TWebsocketMsgBin); procedure SetOnData(const Value: TWebsocketMsgBin);
procedure SetOnTextData(const Value: TWebsocketMsgText); procedure SetOnTextData(const Value: TWebsocketMsgText);
procedure SetWriteTimeout(const Value: Integer); procedure SetWriteTimeout(const Value: Integer);
function GetIOHandler: TIdIOHandlerStack;
procedure SetIOHandlerStack(const Value: TIdIOHandlerStack);
protected protected
FSocketIOCompatible: Boolean; FSocketIOCompatible: Boolean;
FSocketIOHandshakeResponse: string; FSocketIOHandshakeResponse: string;
@ -71,7 +84,8 @@ type
procedure Ping; procedure Ping;
procedure ReadAndProcessData; procedure ReadAndProcessData;
property IOHandler: TIdIOHandlerWebsocket read GetIOHandlerWS write SetIOHandlerWS; property IOHandler: TIdIOHandlerStack read GetIOHandler write SetIOHandlerStack;
property IOHandlerWS: TWebsocketImplementationProxy read GetIOHandlerWS; // write SetIOHandlerWS;
//websockets //websockets
property OnBinData : TWebsocketMsgBin read FOnData write SetOnData; property OnBinData : TWebsocketMsgBin read FOnData write SetOnData;
@ -86,43 +100,11 @@ type
property Host; property Host;
property Port; property Port;
property WSResourceName: string read FWSResourceName write FWSResourceName; property WSResourceName: string read FWSResourceName write FWSResourceName;
property UseSSL: boolean read FUseSSL write FUseSSL;
property WriteTimeout: Integer read FWriteTimeout write SetWriteTimeout default 2000; property WriteTimeout: Integer read FWriteTimeout write SetWriteTimeout default 2000;
end; end;
// on error
(*
TIdHTTPSocketIOClient_old = class(TIdHTTPWebsocketClient)
private
FOnConnected: TNotifyEvent;
FOnDisConnected: TNotifyEvent;
FOnSocketIOMsg: TSocketIOMsg;
FOnSocketIOEvent: TSocketIOMsg;
FOnSocketIOJson: TSocketIOMsg;
protected
FHeartBeat: TTimer;
procedure HeartBeatTimer(Sender: TObject);
procedure InternalUpgradeToWebsocket(aRaiseException: Boolean; out aFailedReason: string);override;
public
procedure AsyncDispatchEvent(const aEvent: string); override;
public
procedure AfterConstruction; override;
destructor Destroy; override;
procedure AutoConnect;
property SocketIOHandshakeResponse: string read FSocketIOHandshakeResponse;
property OnConnected: TNotifyEvent read FOnConnected write FOnConnected;
property OnDisConnected: TNotifyEvent read FOnDisConnected write FOnDisConnected;
// procedure ProcessSocketIORequest(const strmRequest: TStream);
property OnSocketIOMsg : TSocketIOMsg read FOnSocketIOMsg write FOnSocketIOMsg;
property OnSocketIOJson : TSocketIOMsg read FOnSocketIOJson write FOnSocketIOJson;
property OnSocketIOEvent: TSocketIOMsg read FOnSocketIOEvent write FOnSocketIOEvent;
end;
*)
TWSThreadList = class(TThreadList) TWSThreadList = class(TThreadList)
public public
function Count: Integer; function Count: Integer;
@ -181,35 +163,6 @@ uses
var var
GUnitFinalized: Boolean = false; GUnitFinalized: Boolean = false;
//type
// TAnonymousThread = class(TThread)
// protected
// FThreadProc: TThreadProcedure;
// procedure Execute; override;
// public
// constructor Create(AThreadProc: TThreadProcedure);
// end;
//procedure CreateAnonymousThread(AThreadProc: TThreadProcedure);
//begin
// TAnonymousThread.Create(AThreadProc);
//end;
{ TAnonymousThread }
//constructor TAnonymousThread.Create(AThreadProc: TThreadProcedure);
//begin
// FThreadProc := AThreadProc;
// FreeOnTerminate := True;
// inherited Create(False {direct start});
//end;
//
//procedure TAnonymousThread.Execute;
//begin
// if Assigned(FThreadProc) then
// FThreadProc();
//end;
{ TIdHTTPWebsocketClient } { TIdHTTPWebsocketClient }
procedure TIdHTTPWebsocketClient.AfterConstruction; procedure TIdHTTPWebsocketClient.AfterConstruction;
@ -217,9 +170,9 @@ begin
inherited; inherited;
FHash := TIdHashSHA1.Create; FHash := TIdHashSHA1.Create;
IOHandler := TIdIOHandlerWebsocket.Create(nil); //IOHandler := TIdIOHandlerWebsocket.Create(nil);
IOHandler.UseNagle := False; //IOHandler.RealIOHandler.UseNagle := False;
ManagedIOHandler := True; //ManagedIOHandler := True;
FSocketIO := TIdSocketIOHandling_Ext.Create; FSocketIO := TIdSocketIOHandling_Ext.Create;
// FHeartBeat := TTimer.Create(nil); // FHeartBeat := TTimer.Create(nil);
@ -316,7 +269,7 @@ begin
else else
begin begin
//clear inputbuffer, otherwise it can't connect :( //clear inputbuffer, otherwise it can't connect :(
if (IOHandler <> nil) then IOHandler.Clear; if (IOHandlerWS <> nil) then IOHandlerWS.Clear;
inherited Connect; inherited Connect;
end; end;
finally finally
@ -341,7 +294,8 @@ begin
// tmr.Free; // tmr.Free;
// end); // end);
TIdWebsocketMultiReadThread.Instance.RemoveClient(Self); //TIdWebsocketMultiReadThread.Instance.RemoveClient(Self);
DisConnect(True);
FSocketIO.Free; FSocketIO.Free;
FHash.Free; FHash.Free;
inherited; inherited;
@ -350,7 +304,7 @@ end;
procedure TIdHTTPWebsocketClient.DisConnect(ANotifyPeer: Boolean); procedure TIdHTTPWebsocketClient.DisConnect(ANotifyPeer: Boolean);
begin begin
if not SocketIOCompatible and if not SocketIOCompatible and
( (IOHandler <> nil) and not IOHandler.IsWebsocket) ( (IOHandlerWS <> nil) and not IOHandlerWS.IsWebsocket)
then then
TIdWebsocketMultiReadThread.Instance.RemoveClient(Self); TIdWebsocketMultiReadThread.Instance.RemoveClient(Self);
@ -366,18 +320,19 @@ begin
try try
if IOHandler <> nil then if IOHandler <> nil then
begin begin
IOHandler.Lock; IOHandlerWS.Lock;
try try
IOHandler.IsWebsocket := False; IOHandlerWS.IsWebsocket := False;
Self.ManagedIOHandler := False; //otherwise it gets freed while we have a lock on it...
inherited DisConnect(ANotifyPeer); inherited DisConnect(ANotifyPeer);
//clear buffer, other still "connected" //clear buffer, other still "connected"
IOHandler.Clear; IOHandlerWS.Clear;
//IOHandler.Free; //IOHandler.Free;
//IOHandler := TIdIOHandlerWebsocket.Create(nil); //IOHandler := TIdIOHandlerWebsocket.Create(nil);
finally finally
IOHandler.Unlock; IOHandlerWS.Unlock;
end; end;
end; end;
finally finally
@ -385,12 +340,25 @@ begin
end; end;
end; end;
function TIdHTTPWebsocketClient.GetIOHandlerWS: TIdIOHandlerWebsocket; function TIdHTTPWebsocketClient.GetIOHandler: TIdIOHandlerStack;
begin begin
// if inherited IOHandler is TIdIOHandlerWebsocket then Result := inherited IOHandler as TIdIOHandlerStack;
Result := inherited IOHandler as TIdIOHandlerWebsocket if Result = nil then
// else begin
// Assert(False); inherited IOHandler := MakeImplicitClientHandler;
Result := inherited IOHandler as TIdIOHandlerStack;
end;
end;
function TIdHTTPWebsocketClient.GetIOHandlerWS: TWebsocketImplementationProxy;
begin
if FWebsocketImpl = nil then
begin
inherited IOHandler := Self.MakeImplicitClientHandler;
Assert(FWebsocketImpl <> nil);
end;
Result := FWebsocketImpl;
end; end;
function TIdHTTPWebsocketClient.GetSocketIO: TIdSocketIOHandling; function TIdHTTPWebsocketClient.GetSocketIO: TIdSocketIOHandling;
@ -398,59 +366,6 @@ begin
Result := FSocketIO; Result := FSocketIO;
end; end;
(*
procedure TIdHTTPWebsocketClient.HeartBeatTimer(Sender: TObject);
begin
FHeartBeat.Enabled := False;
FSocketIO.Lock;
try
try
if (IOHandler <> nil) and
not IOHandler.ClosedGracefully and
IOHandler.Connected and
(FSocketIOContext <> nil) then
begin
FSocketIO.WritePing(FSocketIOContext as TSocketIOContext); //heartbeat socket.io message
end
//retry re-connect
else
try
//clear inputbuffer, otherwise it can't connect :(
if (IOHandler <> nil) then
IOHandler.Clear;
Self.ConnectTimeout := 100; //100ms otherwise GUI hangs too much -> todo: do it in background thread!
if not Connected then
Self.Connect;
TryUpgradeToWebsocket;
except
//skip, just retried
end;
except on E:Exception do
begin
//clear inputbuffer, otherwise it stays connected :(
if (IOHandler <> nil) then
IOHandler.Clear;
Disconnect(False);
if Assigned(OnDisConnected) then
OnDisConnected(Self);
try
raise EIdException.Create('Connection lost from ' +
Format('ws://%s:%d/%s', [Host, Port, WSResourceName]) +
' - Error: ' + e.Message);
except
//eat, no error popup!
end;
end;
end;
finally
FSocketIO.UnLock;
FHeartBeat.Enabled := True; //always enable: in case of disconnect it will re-connect
end;
end;
*)
function TIdHTTPWebsocketClient.TryConnect: Boolean; function TIdHTTPWebsocketClient.TryConnect: Boolean;
begin begin
Lock; Lock;
@ -483,7 +398,7 @@ begin
FSocketIOConnectBusy := True; FSocketIOConnectBusy := True;
Lock; Lock;
try try
if (IOHandler <> nil) and IOHandler.IsWebsocket then Exit(True); if (IOHandler <> nil) and IOHandlerWS.IsWebsocket then Exit(True);
InternalUpgradeToWebsocket(False{no raise}, sError); InternalUpgradeToWebsocket(False{no raise}, sError);
Result := (sError = ''); Result := (sError = '');
@ -509,7 +424,7 @@ begin
try try
if IOHandler = nil then if IOHandler = nil then
Connect Connect
else if not IOHandler.IsWebsocket then else if not IOHandlerWS.IsWebsocket then
InternalUpgradeToWebsocket(True{raise}, sError); InternalUpgradeToWebsocket(True{raise}, sError);
finally finally
UnLock; UnLock;
@ -525,7 +440,7 @@ var
sSocketioextended: string; sSocketioextended: string;
bLocked: boolean; bLocked: boolean;
begin begin
Assert((IOHandler = nil) or not IOHandler.IsWebsocket); Assert((IOHandler = nil) or not IOHandlerWS.IsWebsocket);
//remove from thread during connection handling //remove from thread during connection handling
TIdWebsocketMultiReadThread.Instance.RemoveClient(Self); TIdWebsocketMultiReadThread.Instance.RemoveClient(Self);
@ -536,10 +451,10 @@ begin
//reset pending data //reset pending data
if IOHandler <> nil then if IOHandler <> nil then
begin begin
IOHandler.Lock; IOHandlerWS.Lock;
bLocked := True; bLocked := True;
if IOHandler.IsWebsocket then Exit; if IOHandlerWS.IsWebsocket then Exit;
IOHandler.Clear; IOHandlerWS.Clear;
end; end;
//special socket.io handling, see https://github.com/LearnBoost/socket.io-spec //special socket.io handling, see https://github.com/LearnBoost/socket.io-spec
@ -547,14 +462,17 @@ begin
begin begin
Request.Clear; Request.Clear;
Request.Connection := 'keep-alive'; Request.Connection := 'keep-alive';
{$IFDEF WEBSOCKETSSL}
sURL := Format('https://%s:%d/socket.io/1/', [Host, Port]); if UseSSL then
{$ELSE} sURL := Format('https://%s:%d/socket.io/1/', [Host, Port])
else
sURL := Format('http://%s:%d/socket.io/1/', [Host, Port]); sURL := Format('http://%s:%d/socket.io/1/', [Host, Port]);
{$ENDIF}
strmResponse.Clear; strmResponse.Clear;
ReadTimeout := 5 * 1000; ReadTimeout := 5 * 1000;
if DebugHook > 0 then
ReadTimeout := ReadTimeout * 10;
//get initial handshake //get initial handshake
Post(sURL, strmResponse, strmResponse); Post(sURL, strmResponse, strmResponse);
if ResponseCode = 200 {OK} then if ResponseCode = 200 {OK} then
@ -619,10 +537,15 @@ begin
//ws://host:port/<resourcename> //ws://host:port/<resourcename>
//about resourcename, see: http://dev.w3.org/html5/websockets/ "Parsing WebSocket URLs" //about resourcename, see: http://dev.w3.org/html5/websockets/ "Parsing WebSocket URLs"
//sURL := Format('ws://%s:%d/%s', [Host, Port, WSResourceName]); //sURL := Format('ws://%s:%d/%s', [Host, Port, WSResourceName]);
if UseSSL then
sURL := Format('https://%s:%d/%s', [Host, Port, WSResourceName])
else
sURL := Format('http://%s:%d/%s', [Host, Port, WSResourceName]); sURL := Format('http://%s:%d/%s', [Host, Port, WSResourceName]);
ReadTimeout := Max(5 * 1000, ReadTimeout); ReadTimeout := Max(5 * 1000, ReadTimeout);
{ voorbeeld: { example:
GET http://localhost:9222/devtools/page/642D7227-148E-47C2-B97A-E00850E3AFA3 HTTP/1.1 GET http://localhost:9222/devtools/page/642D7227-148E-47C2-B97A-E00850E3AFA3 HTTP/1.1
Upgrade: websocket Upgrade: websocket
Connection: Upgrade Connection: Upgrade
@ -636,49 +559,8 @@ begin
User-Agent: Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/27.0.1453.116 Safari/537.36 User-Agent: Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/27.0.1453.116 Safari/537.36
Cookie: __utma=1.2040118404.1366961318.1366961318.1366961318.1; __utmc=1; __utmz=1.1366961318.1.1.utmcsr=(direct)|utmccn=(direct)|utmcmd=(none); deviceorder=0123456789101112; MultiTouchEnabled=false; device=3; network_type=0 Cookie: __utma=1.2040118404.1366961318.1366961318.1366961318.1; __utmc=1; __utmz=1.1366961318.1.1.utmcsr=(direct)|utmccn=(direct)|utmcmd=(none); deviceorder=0123456789101112; MultiTouchEnabled=false; device=3; network_type=0
} }
if SocketIOCompatible then
begin
//1st, try to do socketio specific connection
Response.Clear;
Response.ResponseCode := 0;
Request.URL := sURL;
Request.Method := Id_HTTPMethodGet;
Request.Source := nil;
Response.ContentStream := strmResponse;
PrepareRequest(Request);
//connect and upgrade
ConnectToHost(Request, Response);
//check upgrade succesfull
CheckForGracefulDisconnect(True);
CheckConnected;
Assert(Self.Connected);
if Response.ResponseCode = 0 then
Response.ResponseText := Response.ResponseText
else if Response.ResponseCode <> 200{ok} then
begin
aFailedReason := Format('Error while upgrading: "%d: %s"',[ResponseCode, ResponseText]);
if aRaiseException then
raise EIdWebSocketHandleError.Create(aFailedReason)
else
Exit;
end;
//2nd, get websocket response
Response.Clear;
if IOHandler.CheckForDataOnSource(ReadTimeout) then
begin
Self.FHTTPProto.RetrieveHeaders(MaxHeaderLines);
//Response.RawHeaders.Text := IOHandler.InputBufferAsString();
Response.ResponseText := Response.RawHeaders.Text;
end;
end
else
begin begin
Get(sURL, strmResponse, [101]); Get(sURL, strmResponse, [101]);
end;
//http://www.websocket.org/aboutwebsocket.html //http://www.websocket.org/aboutwebsocket.html
(* HTTP/1.1 101 WebSocket Protocol Handshake (* HTTP/1.1 101 WebSocket Protocol Handshake
@ -692,9 +574,9 @@ begin
Access-Control-Allow-Headers: content-type *) Access-Control-Allow-Headers: content-type *)
//'HTTP/1.1 101 Switching Protocols' //'HTTP/1.1 101 Switching Protocols'
if Response.ResponseCode <> 101 then if ResponseCode <> 101 then
begin begin
aFailedReason := Format('Error while upgrading: "%d: %s"',[Response.ResponseCode, Response.ResponseText]); aFailedReason := Format('Error while upgrading: "%d: %s"',[ResponseCode, ResponseText]);
if aRaiseException then if aRaiseException then
raise EIdWebSocketHandleError.Create(aFailedReason) raise EIdWebSocketHandleError.Create(aFailedReason)
else else
@ -731,9 +613,10 @@ begin
else else
Exit; Exit;
end; end;
end;
//upgrade succesful //upgrade succesful
IOHandler.IsWebsocket := True; IOHandlerWS.IsWebsocket := True;
aFailedReason := ''; aFailedReason := '';
Assert(Connected); Assert(Connected);
@ -752,7 +635,7 @@ begin
strmResponse.Free; strmResponse.Free;
if bLocked and (IOHandler <> nil) then if bLocked and (IOHandler <> nil) then
IOHandler.Unlock; IOHandlerWS.Unlock;
Unlock; Unlock;
//add to thread for auto retry/reconnect //add to thread for auto retry/reconnect
@ -773,16 +656,27 @@ end;
function TIdHTTPWebsocketClient.MakeImplicitClientHandler: TIdIOHandler; function TIdHTTPWebsocketClient.MakeImplicitClientHandler: TIdIOHandler;
begin begin
Result := TIdIOHandlerWebsocket.Create(nil); if UseSSL then
begin
Result := TIdIOHandlerWebsocketSSL.Create(nil);
FWebsocketImpl := (Result as TIdIOHandlerWebsocketSSL).WebsocketImpl;
end
else
begin
Result := TIdIOHandlerWebsocketPlain.Create(nil);
FWebsocketImpl := (Result as TIdIOHandlerWebsocketPlain).WebsocketImpl;
end;
(Result as TIdIOHandlerStack).UseNagle := False;
end; end;
procedure TIdHTTPWebsocketClient.Ping; procedure TIdHTTPWebsocketClient.Ping;
var var
ws: TIdIOHandlerWebsocket; ws: TWebsocketImplementationProxy;
begin begin
if TryLock then if TryLock then
try try
ws := IOHandler as TIdIOHandlerWebsocket; ws := IOHandlerWS;
ws.LastPingTime := Now; ws.LastPingTime := Now;
//socket.io? //socket.io?
@ -818,10 +712,10 @@ var
wscode: TWSDataCode; wscode: TWSDataCode;
begin begin
strmEvent := nil; strmEvent := nil;
IOHandler.Lock; IOHandlerWS.Lock;
try try
//try to process all events //try to process all events
while IOHandler.HasData or while IOHandlerWS.HasData or
(IOHandler.Connected and (IOHandler.Connected and
IOHandler.Readable(0)) do //has some data IOHandler.Readable(0)) do //has some data
begin begin
@ -861,7 +755,7 @@ begin
end; end;
end; end;
finally finally
IOHandler.Unlock; IOHandlerWS.Unlock;
strmEvent.Free; strmEvent.Free;
end; end;
end; end;
@ -875,8 +769,8 @@ begin
if IOHandler <> nil then if IOHandler <> nil then
begin begin
IOHandler.InputBuffer.Clear; IOHandler.InputBuffer.Clear;
IOHandler.BusyUpgrading := False; IOHandlerWS.BusyUpgrading := False;
IOHandler.IsWebsocket := False; IOHandlerWS.IsWebsocket := False;
//close/disconnect internal socket //close/disconnect internal socket
//ws := IndyClient.IOHandler as TIdIOHandlerWebsocket; //ws := IndyClient.IOHandler as TIdIOHandlerWebsocket;
//ws.Close; done in disconnect below //ws.Close; done in disconnect below
@ -884,10 +778,9 @@ begin
Disconnect(False); Disconnect(False);
end; end;
procedure TIdHTTPWebsocketClient.SetIOHandlerWS( procedure TIdHTTPWebsocketClient.SetIOHandlerStack(const Value: TIdIOHandlerStack);
const Value: TIdIOHandlerWebsocket);
begin begin
SetIOHandler(Value); inherited IOHandler := Value;
end; end;
procedure TIdHTTPWebsocketClient.SetOnData(const Value: TWebsocketMsgBin); procedure TIdHTTPWebsocketClient.SetOnData(const Value: TWebsocketMsgBin);
@ -923,253 +816,6 @@ begin
Self.IOHandler.Binding.SetSockOpt(SOL_SOCKET, SO_SNDTIMEO, Self.WriteTimeout); Self.IOHandler.Binding.SetSockOpt(SOL_SOCKET, SO_SNDTIMEO, Self.WriteTimeout);
end; end;
{ TIdHTTPSocketIOClient }
(*
procedure TIdHTTPSocketIOClient_old.AfterConstruction;
begin
inherited;
SocketIOCompatible := True;
FHeartBeat := TTimer.Create(nil);
FHeartBeat.Enabled := False;
FHeartBeat.OnTimer := HeartBeatTimer;
end;
procedure TIdHTTPSocketIOClient_old.AsyncDispatchEvent(const aEvent: string);
begin
//https://github.com/LearnBoost/socket.io-spec
if StartsStr('1:', aEvent) then //connect
Exit;
if aEvent = '2::' then //ping, heartbeat
Exit;
inherited AsyncDispatchEvent(aEvent);
end;
procedure TIdHTTPSocketIOClient_old.AutoConnect;
begin
//for now: timer in mainthread?
TThread.Queue(nil,
procedure
begin
FHeartBeat.Interval := 5 * 1000;
FHeartBeat.Enabled := True;
end);
end;
destructor TIdHTTPSocketIOClient_old.Destroy;
var tmr: TObject;
begin
tmr := FHeartBeat;
TThread.Queue(nil, //otherwise free in other thread than created
procedure
begin
//FHeartBeat.Free;
tmr.Free;
end);
inherited;
end;
procedure TIdHTTPSocketIOClient_old.HeartBeatTimer(Sender: TObject);
begin
FHeartBeat.Enabled := False;
try
try
if (IOHandler <> nil) and
not IOHandler.ClosedGracefully and
IOHandler.Connected then
begin
IOHandler.Write('2:::'); //heartbeat socket.io message
end
//retry connect
else
try
//clear inputbuffer, otherwise it can't connect :(
if (IOHandler <> nil) and
not IOHandler.InputBufferIsEmpty
then
IOHandler.DiscardAll;
Self.Connect;
TryUpgradeToWebsocket;
except
//skip, just retried
end;
except
//clear inputbuffer, otherwise it stays connected :(
if (IOHandler <> nil) and
not IOHandler.InputBufferIsEmpty
then
IOHandler.DiscardAll;
if Assigned(OnDisConnected) then
OnDisConnected(Self);
try
raise EIdException.Create('Connection lost from ' + Format('ws://%s:%d/%s', [Host, Port, WSResourceName]));
except
//eat, no error popup!
end;
end;
finally
FHeartBeat.Enabled := True; //always enable: in case of disconnect it will re-connect
end;
end;
procedure TIdHTTPSocketIOClient_old.InternalUpgradeToWebsocket(
aRaiseException: Boolean; out aFailedReason: string);
var
stimeout: string;
begin
inherited InternalUpgradeToWebsocket(aRaiseException, aFailedReason);
if (aFailedReason = '') and
(IOHandler as TIdIOHandlerWebsocket).IsWebsocket then
begin
stimeout := Copy(SocketIOHandshakeResponse, Pos(':', SocketIOHandshakeResponse)+1, Length(SocketIOHandshakeResponse));
stimeout := Copy(stimeout, 1, Pos(':', stimeout)-1);
if stimeout <> '' then
begin
//if (FHeartBeat.Interval > 0) then
//for now: timer in mainthread?
TThread.Queue(nil,
procedure
begin
FHeartBeat.Interval := StrToIntDef(stimeout, 15) * 1000;
if FHeartBeat.Interval >= 15000 then
//FHeartBeat.Interval := FHeartBeat.Interval - 5000
FHeartBeat.Interval := 5000
else if FHeartBeat.Interval >= 5000 then
FHeartBeat.Interval := FHeartBeat.Interval - 2000;
FHeartBeat.Enabled := (FHeartBeat.Interval > 0);
end);
end;
if Assigned(OnConnected) then
OnConnected(Self);
end;
end;
)
procedure TIdHTTPSocketIOClient_old.ProcessSocketIORequest(
const strmRequest: TStream);
function __ReadToEnd: string;
var
utf8: TBytes;
ilength: Integer;
begin
Result := '';
ilength := strmRequest.Size - strmRequest.Position;
SetLength(utf8, ilength);
strmRequest.Read(utf8[0], ilength);
Result := TEncoding.UTF8.GetString(utf8);
end;
function __GetSocketIOPart(const aData: string; aIndex: Integer): string;
var ipos: Integer;
i: Integer;
begin
//'5::/chat:{"name":"hi!"}'
//0 = 5
//1 =
//2 = /chat
//3 = {"name":"hi!"}
ipos := 0;
for i := 0 to aIndex-1 do
ipos := PosEx(':', aData, ipos+1);
if ipos >= 0 then
begin
Result := Copy(aData, ipos+1, Length(aData));
if aIndex < 3 then // /chat:{"name":"hi!"}'
begin
ipos := PosEx(':', Result, 1); // :{"name":"hi!"}'
if ipos > 0 then
Result := Copy(Result, 1, ipos-1); // /chat
end;
end;
end;
var
str, smsg, schannel, sdata: string;
imsg: Integer;
// bCallback: Boolean;
begin
str := __ReadToEnd;
if str = '' then Exit;
//5:1+:/chat:test
smsg := __GetSocketIOPart(str, 1);
imsg := 0;
// bCallback := False;
if smsg <> '' then // 1+
begin
imsg := StrToIntDef(ReplaceStr(smsg,'+',''), 0); // 1
// bCallback := (Pos('+', smsg) > 1); //trailing +, e.g. 1+
end;
schannel := __GetSocketIOPart(str, 2); // /chat
sdata := __GetSocketIOPart(str, 3); // test
//(0) Disconnect
if StartsStr('0:', str) then
begin
schannel := __GetSocketIOPart(str, 2);
if schannel <> '' then
//todo: close channel
else
Self.Disconnect;
end
//(1) Connect
//'1::' [path] [query]
else if StartsStr('1:', str) then
begin
//todo: add channel/room to authorized channel/room list
Self.IOHandler.Write(str); //write same connect back, e.g. 1::/chat
end
//(2) Heartbeat
else if StartsStr('2:', str) then
begin
Self.IOHandler.Write(str); //write same connect back, e.g. 2::
end
//(3) Message (https://github.com/LearnBoost/socket.io-spec#3-message)
//'3:' [message id ('+')] ':' [message endpoint] ':' [data]
//3::/chat:hi
else if StartsStr('3:', str) then
begin
if Assigned(OnSocketIOMsg) then
OnSocketIOMsg(Self, sdata, imsg);
end
//(4) JSON Message
//'4:' [message id ('+')] ':' [message endpoint] ':' [json]
//4:1::{"a":"b"}
else if StartsStr('4:', str) then
begin
if Assigned(OnSocketIOJson) then
OnSocketIOJson(Self, sdata, imsg);
end
//(5) Event
//'5:' [message id ('+')] ':' [message endpoint] ':' [json encoded event]
//5::/chat:{"name":"my other event","args":[{"my":"data"}]}
//5:1+:/chat:{"name":"GetLocations","args":[""]}
else if StartsStr('5:', str) then
begin
if Assigned(OnSocketIOEvent) then
OnSocketIOEvent(Self, sdata, imsg);
end
//(6) ACK
//6::/news:1+["callback"]
//6:::1+["Response"]
//(7) Error
//(8) Noop
else if StartsStr('8:', str) then
begin
//nothing
end
else
raise Exception.CreateFmt('Unsupported data: "%s"', [str]);
end;
*)
{ TIdWebsocketMultiReadThread } { TIdWebsocketMultiReadThread }
procedure TIdWebsocketMultiReadThread.AddClient( procedure TIdWebsocketMultiReadThread.AddClient(
@ -1309,7 +955,7 @@ procedure TIdWebsocketMultiReadThread.PingAllChannels;
var var
l: TList; l: TList;
chn: TIdHTTPWebsocketClient; chn: TIdHTTPWebsocketClient;
ws: TIdIOHandlerWebsocket; ws: TWebsocketImplementationProxy;
i: Integer; i: Integer;
begin begin
if Terminated then Exit; if Terminated then Exit;
@ -1321,10 +967,10 @@ begin
chn := TIdHTTPWebsocketClient(l.Items[i]); chn := TIdHTTPWebsocketClient(l.Items[i]);
if chn.NoAsyncRead then Continue; if chn.NoAsyncRead then Continue;
ws := chn.IOHandler as TIdIOHandlerWebsocket; ws := chn.IOHandlerWS;
//valid? //valid?
if (chn.IOHandler <> nil) and if (chn.IOHandler <> nil) and
(chn.IOHandler.IsWebsocket) and (chn.IOHandlerWS.IsWebsocket) and
(chn.Socket <> nil) and (chn.Socket <> nil) and
(chn.Socket.Binding <> nil) and (chn.Socket.Binding <> nil) and
(chn.Socket.Binding.Handle > 0) and (chn.Socket.Binding.Handle > 0) and
@ -1391,7 +1037,7 @@ begin
end; end;
//try reconnect //try reconnect
ws := chn.IOHandler as TIdIOHandlerWebsocket; ws := chn.IOHandlerWS;
if ( (ws = nil) or if ( (ws = nil) or
(SecondsBetween(Now, ws.LastActivityTime) >= 5) ) then (SecondsBetween(Now, ws.LastActivityTime) >= 5) ) then
begin begin
@ -1433,7 +1079,7 @@ var
iCount, iCount,
i: Integer; i: Integer;
iResult: NativeInt; iResult: NativeInt;
ws: TIdIOHandlerWebsocket; ws: TWebsocketImplementationProxy;
begin begin
l := FChannels.LockList; l := FChannels.LockList;
try try
@ -1449,13 +1095,13 @@ begin
//valid? //valid?
if //not chn.Busy and also take busy channels (will be ignored later), otherwise we have to break/reset for each RO function execution if //not chn.Busy and also take busy channels (will be ignored later), otherwise we have to break/reset for each RO function execution
(chn.IOHandler <> nil) and (chn.IOHandler <> nil) and
(chn.IOHandler.IsWebsocket) and (chn.IOHandlerWS.IsWebsocket) and
(chn.Socket <> nil) and (chn.Socket <> nil) and
(chn.Socket.Binding <> nil) and (chn.Socket.Binding <> nil) and
(chn.Socket.Binding.Handle > 0) and (chn.Socket.Binding.Handle > 0) and
(chn.Socket.Binding.Handle <> INVALID_SOCKET) then (chn.Socket.Binding.Handle <> INVALID_SOCKET) then
begin begin
if chn.IOHandler.HasData then if chn.IOHandlerWS.HasData then
begin begin
Inc(iResult); Inc(iResult);
Break; Break;
@ -1513,13 +1159,12 @@ begin
//check for data for all channels //check for data for all channels
for i := 0 to l.Count - 1 do for i := 0 to l.Count - 1 do
begin begin
if l = nil then Exit;
chn := TIdHTTPWebsocketClient(l.Items[i]); chn := TIdHTTPWebsocketClient(l.Items[i]);
if chn.NoAsyncRead then Continue; if chn.NoAsyncRead then Continue;
if chn.TryLock then if chn.TryLock then
try try
ws := chn.IOHandler as TIdIOHandlerWebsocket; ws := chn.IOHandlerWS;
if (ws = nil) then Continue; if (ws = nil) then Continue;
if ws.TryLock then //IOHandler.Readable cannot be done during pending action! if ws.TryLock then //IOHandler.Readable cannot be done during pending action!

637
IdIOHandlerWebsocket.pas
View file

File diff suppressed because it is too large Load diff

144
IdServerIOHandlerWebsocket.pas
View file

@ -1,36 +1,26 @@
unit IdServerIOHandlerWebsocket; unit IdServerIOHandlerWebsocket;
interface interface
{$I wsdefines.pas}
uses uses
Classes Classes,
, IdServerIOHandlerStack IdServerIOHandlerStack, IdIOHandlerStack, IdGlobal, IdIOHandler, IdYarn, IdThread, IdSocketHandle,
, IdIOHandlerStack IdIOHandlerWebsocket, IdSSLOpenSSL, sysutils;
, IdGlobal
, IdIOHandler
, IdYarn
, IdThread
, IdSocketHandle
//
, IdIOHandlerWebsocket
{$IFDEF WEBSOCKETSSL}
, IdSSLOpenSSL
{$ENDIF}
;
type type
{$IFDEF WEBSOCKETSSL}
TIdServerIOHandlerWebsocket = class(TIdServerIOHandlerSSLOpenSSL)
{$ELSE}
TIdServerIOHandlerWebsocket = class(TIdServerIOHandlerStack) TIdServerIOHandlerWebsocket = class(TIdServerIOHandlerStack)
{$ENDIF}
protected protected
procedure InitComponent; override; procedure InitComponent; override;
{$IFDEF WEBSOCKETSSL}
function CreateOpenSSLSocket:TIdSSLIOHandlerSocketOpenSSL; override;
{$ENDIF}
public public
function Accept(ASocket: TIdSocketHandle; AListenerThread: TIdThread; function Accept(ASocket: TIdSocketHandle; AListenerThread: TIdThread; AYarn: TIdYarn): TIdIOHandler; override;
AYarn: TIdYarn): TIdIOHandler; override; function MakeClientIOHandler(ATheThread:TIdYarn): TIdIOHandler; override;
end;
TIdServerIOHandlerWebsocketSSL = class(TIdServerIOHandlersslOpenSSL)
protected
procedure InitComponent; override;
public
function Accept(ASocket: TIdSocketHandle; AListenerThread: TIdThread; AYarn: TIdYarn): TIdIOHandler; override;
function MakeClientIOHandler(ATheThread:TIdYarn): TIdIOHandler; override; function MakeClientIOHandler(ATheThread:TIdYarn): TIdIOHandler; override;
end; end;
@ -38,43 +28,115 @@ implementation
{ TIdServerIOHandlerStack_Websocket } { TIdServerIOHandlerStack_Websocket }
{$IFDEF WEBSOCKETSSL}
function TIdServerIOHandlerWebsocket.CreateOpenSSLSocket:TIdSSLIOHandlerSocketOpenSSL;
begin
Result := TIdIOHandlerWebsocket.Create(nil);
end;
{$ENDIF}
function TIdServerIOHandlerWebsocket.Accept(ASocket: TIdSocketHandle; function TIdServerIOHandlerWebsocket.Accept(ASocket: TIdSocketHandle;
AListenerThread: TIdThread; AYarn: TIdYarn): TIdIOHandler; AListenerThread: TIdThread; AYarn: TIdYarn): TIdIOHandler;
var
LIOHandler: TIdIOHandlerWebsocketPlain;
begin begin
Result := inherited Accept(ASocket, AListenerThread, AYarn); //Result := inherited Accept(ASocket, AListenerThread, AYarn);
//using a custom scheduler, AYarn may be nil, so don't assert
Assert(ASocket<>nil);
Assert(AListenerThread<>nil);
Result := nil;
LIOHandler := TIdIOHandlerWebsocketPlain.Create(nil);
try
LIOHandler.Open;
while not AListenerThread.Stopped do
begin
if ASocket.Select(250) then
begin
if LIOHandler.Binding.Accept(ASocket.Handle) then
begin
LIOHandler.AfterAccept;
Result := LIOHandler;
LIOHandler := nil;
Break;
end;
end;
end;
finally
FreeAndNil(LIOHandler);
end;
if Result <> nil then if Result <> nil then
begin begin
(Result as TIdIOHandlerWebsocket).IsServerSide := True; //server must not mask, only client (Result as TIdIOHandlerWebsocketPlain).WebsocketImpl.IsServerSide := True; //server must not mask, only client
(Result as TIdIOHandlerWebsocket).UseNagle := False; (Result as TIdIOHandlerWebsocketPlain).UseNagle := False;
end; end;
end; end;
procedure TIdServerIOHandlerWebsocket.InitComponent; procedure TIdServerIOHandlerWebsocket.InitComponent;
begin begin
inherited InitComponent; inherited InitComponent;
{$IFNDEF WEBSOCKETSSL} //IOHandlerSocketClass := TIdIOHandlerWebsocket;
IOHandlerSocketClass := TIdIOHandlerWebsocket;
{$ENDIF}
end; end;
function TIdServerIOHandlerWebsocket.MakeClientIOHandler( function TIdServerIOHandlerWebsocket.MakeClientIOHandler(
ATheThread: TIdYarn): TIdIOHandler; ATheThread: TIdYarn): TIdIOHandler;
begin begin
Result := inherited MakeClientIOHandler(ATheThread); Result := inherited MakeClientIOHandler(ATheThread);
{$IFNDEF WEBSOCKETSSL}
if Result <> nil then if Result <> nil then
begin begin
(Result as TIdIOHandlerWebsocket).IsServerSide := True; //server must not mask, only client (Result as TIdIOHandlerWebsocketPlain).WebsocketImpl.IsServerSide := True; //server must not mask, only client
(Result as TIdIOHandlerWebsocket).UseNagle := False; (Result as TIdIOHandlerWebsocketPlain).UseNagle := False;
end;
end;
{ TIdServerIOHandlerWebsocketSSL }
function TIdServerIOHandlerWebsocketSSL.Accept(ASocket: TIdSocketHandle; AListenerThread: TIdThread;
AYarn: TIdYarn): TIdIOHandler;
var
LIO: TIdIOHandlerWebsocketSSL;
begin
Assert(ASocket<>nil);
Assert(fSSLContext<>nil);
LIO := TIdIOHandlerWebsocketSSL.Create(nil);
try
LIO.PassThrough := True; //initial no ssl?
//we need to pass the SSLOptions for the socket from the server
LIO.SSLOptions := SSLOptions;
LIO.IsPeer := True; //shared SSLOptions + fSSLContext
LIO.Open;
if LIO.Binding.Accept(ASocket.Handle) then
begin
//LIO.ClearSSLOptions;
LIO.SSLSocket := TIdSSLSocket.Create(Self);
LIO.SSLContext := fSSLContext;
end
else
begin
FreeAndNil(LIO);
end;
except
LIO.Free;
raise;
end;
Result := LIO;
if Result <> nil then
begin
(Result as TIdIOHandlerWebsocketSSL).WebsocketImpl.IsServerSide := True; //server must not mask, only client
(Result as TIdIOHandlerWebsocketSSL).UseNagle := False;
end;
end;
procedure TIdServerIOHandlerWebsocketSSL.InitComponent;
begin
inherited InitComponent;
//IOHandlerSocketClass := TIdIOHandlerWebsocket;
end;
function TIdServerIOHandlerWebsocketSSL.MakeClientIOHandler(ATheThread: TIdYarn): TIdIOHandler;
begin
Result := inherited MakeClientIOHandler(ATheThread);
if Result <> nil then
begin
(Result as TIdIOHandlerWebsocketSSL).WebsocketImpl.IsServerSide := True; //server must not mask, only client
(Result as TIdIOHandlerWebsocketSSL).UseNagle := False;
end; end;
{$ENDIF}
end; end;
end. end.

62
IdServerSocketIOHandling.pas
View file

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

35
IdServerWebsocketContext.pas
View file

@ -1,22 +1,16 @@
unit IdServerWebsocketContext; unit IdServerWebsocketContext;
interface interface
{$I wsdefines.pas}
uses uses
Classes, strUtils Classes,
, IdContext IdCustomTCPServer, IdIOHandlerWebsocket,
, IdCustomTCPServer IdServerBaseHandling, IdServerSocketIOHandling, IdContext, IdIOHandlerStack;
, IdCustomHTTPServer
//
, IdIOHandlerWebsocket
, IdServerBaseHandling
, IdServerSocketIOHandling
;
type type
TIdServerWSContext = class; TIdServerWSContext = class;
TWebSocketUpgradeEvent = procedure(const AContext: TIdServerWSContext; ARequestInfo: TIdHTTPRequestInfo; var Accept:boolean) of object; TWebsocketChannelRequest = procedure(const AContext: TIdServerWSContext; aType: TWSDataType; const strmRequest, strmResponse: TMemoryStream) of object;
TWebsocketChannelRequest = procedure(const AContext: TIdServerWSContext; var aType:TWSDataType; const strmRequest, strmResponse: TMemoryStream) of object;
TIdServerWSContext = class(TIdServerContext) TIdServerWSContext = class(TIdServerContext)
private private
@ -31,12 +25,12 @@ type
FWebSocketExtensions: string; FWebSocketExtensions: string;
FCookie: string; FCookie: string;
//FSocketIOPingSend: Boolean; //FSocketIOPingSend: Boolean;
fOnWebSocketUpgrade: TWebSocketUpgradeEvent;
FOnCustomChannelExecute: TWebsocketChannelRequest; FOnCustomChannelExecute: TWebsocketChannelRequest;
FSocketIO: TIdServerSocketIOHandling; FSocketIO: TIdServerSocketIOHandling;
FOnDestroy: TIdContextEvent; FOnDestroy: TIdContextEvent;
public public
function IOHandler: TIdIOHandlerWebsocket; function IOHandler: TIdIOHandlerStack;
function WebsocketImpl: TWebsocketImplementationProxy;
public public
function IsSocketIO: Boolean; function IsSocketIO: Boolean;
property SocketIO: TIdServerSocketIOHandling read FSocketIO write FSocketIO; property SocketIO: TIdServerSocketIOHandling read FSocketIO write FSocketIO;
@ -57,12 +51,14 @@ type
property WebSocketVersion : Integer read FWebSocketVersion write FWebSocketVersion; property WebSocketVersion : Integer read FWebSocketVersion write FWebSocketVersion;
property WebSocketExtensions: string read FWebSocketExtensions write FWebSocketExtensions; property WebSocketExtensions: string read FWebSocketExtensions write FWebSocketExtensions;
public public
property OnWebSocketUpgrade: TWebsocketUpgradeEvent read FOnWebSocketUpgrade write FOnWebSocketUpgrade;
property OnCustomChannelExecute: TWebsocketChannelRequest read FOnCustomChannelExecute write FOnCustomChannelExecute; property OnCustomChannelExecute: TWebsocketChannelRequest read FOnCustomChannelExecute write FOnCustomChannelExecute;
end; end;
implementation implementation
uses
StrUtils;
{ TIdServerWSContext } { TIdServerWSContext }
destructor TIdServerWSContext.Destroy; destructor TIdServerWSContext.Destroy;
@ -72,9 +68,9 @@ begin
inherited; inherited;
end; end;
function TIdServerWSContext.IOHandler: TIdIOHandlerWebsocket; function TIdServerWSContext.IOHandler: TIdIOHandlerStack;
begin begin
Result := Self.Connection.IOHandler as TIdIOHandlerWebsocket; Result := Self.Connection.IOHandler as TIdIOHandlerStack;
end; end;
function TIdServerWSContext.IsSocketIO: Boolean; function TIdServerWSContext.IsSocketIO: Boolean;
@ -83,4 +79,9 @@ begin
Result := StartsText('/socket.io/1/websocket/', FPath); Result := StartsText('/socket.io/1/websocket/', FPath);
end; end;
function TIdServerWSContext.WebsocketImpl: TWebsocketImplementationProxy;
begin
Result := (IOHandler as IWebsocketFunctions).WebsocketImpl;
end;
end. end.

90
IdServerWebsocketHandling.pas
View file

@ -1,33 +1,27 @@
unit IdServerWebsocketHandling; unit IdServerWebsocketHandling;
interface interface
{$I wsdefines.pas}
uses uses
Classes, StrUtils, SysUtils, DateUtils IdContext, IdCustomHTTPServer,
, IdCoderMIME
, IdThread
, IdContext
, IdCustomHTTPServer
{$IF CompilerVersion <= 21.0} //D2010 {$IF CompilerVersion <= 21.0} //D2010
, IdHashSHA1 IdHashSHA1,
{$else} {$else}
, IdHashSHA //XE3 etc IdHashSHA, //XE3 etc
{$IFEND} {$IFEND}
, IdServerSocketIOHandling IdServerSocketIOHandling, IdServerWebsocketContext,
// Classes, IdServerBaseHandling, IdIOHandlerWebsocket, IdSocketIOHandling;
, IdSocketIOHandling
, IdServerBaseHandling
, IdServerWebsocketContext
, IdIOHandlerWebsocket
;
type type
TIdServerSocketIOHandling_Ext = class(TIdServerSocketIOHandling) TIdServerSocketIOHandling_Ext = class(TIdServerSocketIOHandling)
end; end;
TIdCustomHTTPServer_Ext = class(TIdCustomHTTPServer);
TIdServerWebsocketHandling = class(TIdServerBaseHandling) TIdServerWebsocketHandling = class(TIdServerBaseHandling)
protected protected
class procedure DoWSExecute(AThread: TIdContext; aSocketIOHandler: TIdServerSocketIOHandling_Ext);virtual; class procedure DoWSExecute(AThread: TIdContext; aSocketIOHandler: TIdServerSocketIOHandling_Ext);virtual;
class procedure HandleWSMessage(AContext: TIdServerWSContext; var aType: TWSDataType; class procedure HandleWSMessage(AContext: TIdServerWSContext; aType: TWSDataType;
aRequestStrm, aResponseStrm: TMemoryStream; aRequestStrm, aResponseStrm: TMemoryStream;
aSocketIOHandler: TIdServerSocketIOHandling_Ext);virtual; aSocketIOHandler: TIdServerSocketIOHandling_Ext);virtual;
public public
@ -39,6 +33,10 @@ type
implementation implementation
uses
StrUtils, SysUtils, DateUtils,
IdCustomTCPServer, IdCoderMIME, IdThread;
{ TIdServerWebsocketHandling } { TIdServerWebsocketHandling }
class function TIdServerWebsocketHandling.CurrentSocket: ISocketIOContext; class function TIdServerWebsocketHandling.CurrentSocket: ISocketIOContext;
@ -65,10 +63,10 @@ begin
try try
context := AThread as TIdServerWSContext; context := AThread as TIdServerWSContext;
//todo: make seperate function + do it after first real write (not header!) //todo: make seperate function + do it after first real write (not header!)
if context.IOHandler.BusyUpgrading then if context.WebsocketImpl.BusyUpgrading then
begin begin
context.IOHandler.IsWebsocket := True; context.WebsocketImpl.IsWebsocket := True;
context.IOHandler.BusyUpgrading := False; context.WebsocketImpl.BusyUpgrading := False;
end; end;
//initial connect //initial connect
if context.IsSocketIO then if context.IsSocketIO then
@ -83,10 +81,13 @@ begin
while AThread.Connection.Connected do while AThread.Connection.Connected do
begin begin
if context.IOHandler.HasData or if context.WebsocketImpl.HasData or
(AThread.Connection.IOHandler.InputBuffer.Size > 0) or (AThread.Connection.IOHandler.InputBuffer.Size > 0) or
AThread.Connection.IOHandler.Readable(1 * 1000) then //wait 5s, else ping the client(!) AThread.Connection.IOHandler.Readable(1 * 1000) then //wait 5s, else ping the client(!)
begin begin
if not (context.WebsocketImpl.HasData or (context.IOHandler.InputBuffer.Size > 0)) then
Continue;
tstart := Now; tstart := Now;
strmResponse := TMemoryStream.Create; strmResponse := TMemoryStream.Create;
@ -103,24 +104,32 @@ begin
if wscode in [wdcPing, wdcPong] then if wscode in [wdcPing, wdcPong] then
begin begin
if wscode = wdcPing then if wscode = wdcPing then
context.IOHandler.WriteData(nil, wdcPong); context.WebsocketImpl.WriteData(nil, wdcPong);
Continue; Continue;
end; end;
if wscode = wdcText if wscode = wdcText then
then wstype := wdtText wstype := wdtText
else wstype := wdtBinary; else
wstype := wdtBinary;
try
HandleWSMessage(context, wstype, strmRequest, strmResponse, aSocketIOHandler); HandleWSMessage(context, wstype, strmRequest, strmResponse, aSocketIOHandler);
except
on E:Exception do
TIdCustomHTTPServer_Ext(context.Server as TIdCustomHTTPServer).DoCommandError(context, nil, nil, E);
end;
//write result back (of the same type: text or bin) //write result back (of the same type: text or bin)
if strmResponse.Size > 0 then if strmResponse.Size > 0 then
begin begin
if wstype = wdtText if wscode = wdcText then
then context.IOHandler.Write(strmResponse, wdtText) context.WebsocketImpl.Write(strmResponse, wdtText)
else context.IOHandler.Write(strmResponse, wdtBinary) else
context.WebsocketImpl.Write(strmResponse, wdtBinary)
end end
else context.IOHandler.WriteData(nil, wdcPing); else
context.WebsocketImpl.WriteData(nil, wdcPing);
finally finally
strmRequest.Free; strmRequest.Free;
strmResponse.Free; strmResponse.Free;
@ -138,7 +147,7 @@ begin
aSocketIOHandler.WritePing(context); aSocketIOHandler.WritePing(context);
end end
else else
context.IOHandler.WriteData(nil, wdcPing); context.WebsocketImpl.WriteData(nil, wdcPing);
end; end;
end; end;
@ -148,12 +157,14 @@ begin
Assert(aSocketIOHandler <> nil); Assert(aSocketIOHandler <> nil);
aSocketIOHandler.WriteDisConnect(context); aSocketIOHandler.WriteDisConnect(context);
end; end;
context.IOHandler.Clear; context.WebsocketImpl.Clear;
AThread.Data := nil; AThread.Data := nil;
end; end;
end; end;
class procedure TIdServerWebsocketHandling.HandleWSMessage(AContext: TIdServerWSContext; var aType:TWSDataType; aRequestStrm, aResponseStrm: TMemoryStream; aSocketIOHandler: TIdServerSocketIOHandling_Ext); class procedure TIdServerWebsocketHandling.HandleWSMessage(AContext: TIdServerWSContext; aType: TWSDataType;
aRequestStrm, aResponseStrm: TMemoryStream;
aSocketIOHandler: TIdServerSocketIOHandling_Ext);
begin begin
if AContext.IsSocketIO then if AContext.IsSocketIO then
begin begin
@ -169,7 +180,6 @@ class function TIdServerWebsocketHandling.ProcessServerCommandGet(
AThread: TIdServerWSContext; ARequestInfo: TIdHTTPRequestInfo; AThread: TIdServerWSContext; ARequestInfo: TIdHTTPRequestInfo;
AResponseInfo: TIdHTTPResponseInfo): Boolean; AResponseInfo: TIdHTTPResponseInfo): Boolean;
var var
Accept: Boolean;
sValue, squid: string; sValue, squid: string;
context: TIdServerWSContext; context: TIdServerWSContext;
hash: TIdHashSHA1; hash: TIdHashSHA1;
@ -194,7 +204,8 @@ begin
Sec-WebSocket-Version: 13 *) Sec-WebSocket-Version: 13 *)
//Connection: Upgrade //Connection: Upgrade
if not ContainsText(ARequestInfo.Connection, 'Upgrade') then //Firefox uses "keep-alive, Upgrade" if not ( ContainsText(ARequestInfo.Connection, 'Upgrade') or //Firefox uses "keep-alive, Upgrade"
ContainsText(ARequestInfo.RawHeaders.Values['upgrade'], 'websocket') ) then //"connection" is empty in case of SSL? so check header too
begin begin
//initiele ondersteuning voor socket.io //initiele ondersteuning voor socket.io
if SameText(ARequestInfo.document , '/socket.io/1/') then if SameText(ARequestInfo.document , '/socket.io/1/') then
@ -244,13 +255,6 @@ begin
Result := True; //handled Result := True; //handled
context := AThread as TIdServerWSContext; context := AThread as TIdServerWSContext;
if Assigned(Context.OnWebSocketUpgrade) then
begin
Accept := True;
Context.OnWebSocketUpgrade(Context,ARequestInfo,Accept);
if not Accept then Abort;
end;
//Sec-WebSocket-Key: dGhlIHNhbXBsZSBub25jZQ== //Sec-WebSocket-Key: dGhlIHNhbXBsZSBub25jZQ==
sValue := ARequestInfo.RawHeaders.Values['sec-websocket-key']; sValue := ARequestInfo.RawHeaders.Values['sec-websocket-key'];
//"The value of this header field MUST be a nonce consisting of a randomly //"The value of this header field MUST be a nonce consisting of a randomly
@ -332,17 +336,21 @@ begin
hash.Free; hash.Free;
end; end;
AResponseInfo.CustomHeaders.Values['Sec-WebSocket-Accept'] := sValue; AResponseInfo.CustomHeaders.Values['Sec-WebSocket-Accept'] := sValue;
AResponseInfo.CustomHeaders.Values['Keep-alive'] := 'true';
//send same protocol back? //send same protocol back?
AResponseInfo.CustomHeaders.Values['Sec-WebSocket-Protocol'] := context.WebSocketProtocol; AResponseInfo.CustomHeaders.Values['Sec-WebSocket-Protocol'] := context.WebSocketProtocol;
//we do not support extensions yet (gzip deflate compression etc) //we do not support extensions yet (gzip deflate compression etc)
//AResponseInfo.CustomHeaders.Values['Sec-WebSocket-Extensions'] := context.WebSocketExtensions; //AResponseInfo.CustomHeaders.Values['Sec-WebSocket-Extensions'] := context.WebSocketExtensions;
//http://www.lenholgate.com/blog/2011/07/websockets---the-deflate-stream-extension-is-broken-and-badly-designed.html //http://www.lenholgate.com/blog/2011/07/websockets---the-deflate-stream-extension-is-broken-and-badly-designed.html
//but is could be done using idZlib.pas and DecompressGZipStream etc //but is could be done using idZlib.pas and DecompressGZipStream etc
AResponseInfo.CustomHeaders.Values['sec-websocket-extensions'] := '';
context.WebSocketExtensions := '';
//send response back //send response back
context.IOHandler.InputBuffer.Clear; context.IOHandler.InputBuffer.Clear;
context.IOHandler.BusyUpgrading := True; context.WebsocketImpl.BusyUpgrading := True;
AResponseInfo.WriteHeader; AResponseInfo.WriteHeader;
//handle all WS communication in seperate loop //handle all WS communication in seperate loop

269
IdSocketIOHandling.pas
View file

@ -1,24 +1,14 @@
unit IdSocketIOHandling; unit IdSocketIOHandling;
interface interface
{$I wsdefines.pas}
uses uses
windows, SyncObjs, SysUtils, StrUtils, Classes, Generics.Collections Classes, Generics.Collections,
{$IFDEF SUPEROBJECT} superobject,
, superobject IdServerBaseHandling, IdContext, IdException, IdIOHandlerWebsocket, IdHTTP,
{$ENDIF} SyncObjs, SysUtils, IdIOHandlerStack;
, IdContext
, IdException
, IdHTTP
//
, IdServerBaseHandling
, IdIOHandlerWebsocket
;
type type
{$IFNDEF SUPEROBJECT}
TSuperArray = String;
{$ENDIF}
TSocketIOContext = class; TSocketIOContext = class;
TSocketIOCallbackObj = class; TSocketIOCallbackObj = class;
TIdBaseSocketIOHandling = class; TIdBaseSocketIOHandling = class;
@ -28,13 +18,9 @@ type
ISocketIOCallback = interface; ISocketIOCallback = interface;
TSocketIOMsg = reference to procedure(const ASocket: ISocketIOContext; const aText: string; const aCallback: ISocketIOCallback); TSocketIOMsg = reference to procedure(const ASocket: ISocketIOContext; const aText: string; const aCallback: ISocketIOCallback);
{$IFDEF SUPEROBJECT}
TSocketIOMsgJSON = reference to procedure(const ASocket: ISocketIOContext; const aJSON: ISuperObject; const aCallback: ISocketIOCallback); TSocketIOMsgJSON = reference to procedure(const ASocket: ISocketIOContext; const aJSON: ISuperObject; const aCallback: ISocketIOCallback);
{$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); TSocketIONotify = reference to procedure(const ASocket: ISocketIOContext);
TSocketIOEvent = reference to procedure(const ASocket: ISocketIOContext; const aArgument: TSuperArray; const aCallback: ISocketIOCallback);
TSocketIOError = reference to procedure(const ASocket: ISocketIOContext; const aErrorClass, aErrorMessage: string); TSocketIOError = reference to procedure(const ASocket: ISocketIOContext; const aErrorClass, aErrorMessage: string);
TSocketIOEventError = reference to procedure(const ASocket: ISocketIOContext; const aCallback: ISocketIOCallback; E: Exception); TSocketIOEventError = reference to procedure(const ASocket: ISocketIOContext; const aCallback: ISocketIOCallback; E: Exception);
@ -62,15 +48,14 @@ type
function IsDisconnected: Boolean; function IsDisconnected: Boolean;
{$IFDEF SUPEROBJECT}
procedure EmitEvent(const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);overload; procedure EmitEvent(const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);overload;
procedure SendJSON(const aJSON: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);
{$ENDIF}
procedure EmitEvent(const aEventName: string; const aData: string; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);overload; procedure EmitEvent(const aEventName: string; const aData: string; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);overload;
procedure Send(const aData: string; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil); procedure Send(const aData: string; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);
procedure SendJSON(const aJSON: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);
end; end;
TSocketIOContext = class(TInterfacedObject,ISocketIOContext) TSocketIOContext = class(TInterfacedObject,
ISocketIOContext)
private private
FLock: TCriticalSection; FLock: TCriticalSection;
FPingSend: Boolean; FPingSend: Boolean;
@ -89,7 +74,7 @@ type
protected protected
FHandling: TIdBaseSocketIOHandling; FHandling: TIdBaseSocketIOHandling;
FContext: TIdContext; FContext: TIdContext;
FIOHandler: TIdIOHandlerWebsocket; FIOHandler: TIdIOHandlerStack;
FClient: TIdHTTP; FClient: TIdHTTP;
FEvent: TEvent; FEvent: TEvent;
FQueue: TList<string>; FQueue: TList<string>;
@ -119,15 +104,14 @@ type
property CustomData: TObject read GetCustomData write SetCustomData; property CustomData: TObject read GetCustomData write SetCustomData;
property OwnsCustomData: Boolean read GetOwnsCustomData write SetOwnsCustomData; property OwnsCustomData: Boolean read GetOwnsCustomData write SetOwnsCustomData;
procedure EmitEvent(const aEventName: string; const aData: string; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);overload;
procedure Send(const aData: string; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);
{$IFDEF SUPEROBJECT}
//todo: OnEvent per socket //todo: OnEvent per socket
//todo: store session info per connection (see Socket.IO Set + Get -> Storing data associated to a client) //todo: store session info per connection (see Socket.IO Set + Get -> Storing data associated to a client)
//todo: namespace using "Of" //todo: namespace using "Of"
procedure EmitEvent(const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);overload; procedure EmitEvent(const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);overload;
procedure EmitEvent(const aEventName: string; const aData: string; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);overload;
// procedure BroadcastEventToOthers(const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil);
procedure Send(const aData: string; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);
procedure SendJSON(const aJSON: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil); procedure SendJSON(const aJSON: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);
{$ENDIF}
end; end;
ISocketIOCallback = interface ISocketIOCallback = interface
@ -153,9 +137,7 @@ type
protected protected
Done, Success: Boolean; Done, Success: Boolean;
Error: Exception; Error: Exception;
{$IFDEF SUPEROBJECT}
Data : ISuperObject; Data : ISuperObject;
{$ENDIF}
Event: TEvent; Event: TEvent;
public public
procedure AfterConstruction; override; procedure AfterConstruction; override;
@ -176,13 +158,12 @@ type
FOnDisconnectList: TSocketIONotifyList; FOnDisconnectList: TSocketIONotifyList;
FOnEventList: TObjectDictionary<string,TSocketIOEventList>; FOnEventList: TObjectDictionary<string,TSocketIOEventList>;
FOnSocketIOMsg: TSocketIOMsg; FOnSocketIOMsg: TSocketIOMsg;
{$IFDEF SUPEROBJECT}
FOnSocketIOJson: TSocketIOMsgJSON; FOnSocketIOJson: TSocketIOMsgJSON;
{$ENDIF}
procedure ProcessEvent(const AContext: ISocketIOContext; const aText: string; aMsgNr: Integer; aHasCallback: Boolean); procedure ProcessEvent(const AContext: ISocketIOContext; const aText: string; aMsgNr: Integer; aHasCallback: Boolean);
private private
FOnEventError: TSocketIOEventError; FOnEventError: TSocketIOEventError;
FDefaultErrorCallback: TSocketIOError;
protected protected
type type
TSocketIOCallback = procedure(const aData: string) of object; TSocketIOCallback = procedure(const aData: string) of object;
@ -206,9 +187,7 @@ type
procedure WriteSocketIOJSON(const ASocket: ISocketIOContext; const aRoom, aJSON: string; aCallback: TSocketIOCallbackRef = nil; const aOnError: TSocketIOError = nil); procedure WriteSocketIOJSON(const ASocket: ISocketIOContext; const aRoom, aJSON: string; aCallback: TSocketIOCallbackRef = nil; const aOnError: TSocketIOError = nil);
procedure WriteSocketIOEvent(const ASocket: ISocketIOContext; const aRoom, aEventName, aJSONArray: string; aCallback: TSocketIOCallback; const aOnError: TSocketIOError); procedure WriteSocketIOEvent(const ASocket: ISocketIOContext; const aRoom, aEventName, aJSONArray: string; aCallback: TSocketIOCallback; const aOnError: TSocketIOError);
procedure WriteSocketIOEventRef(const ASocket: ISocketIOContext; const aRoom, aEventName, aJSONArray: string; aCallback: TSocketIOCallbackRef; const aOnError: TSocketIOError); procedure WriteSocketIOEventRef(const ASocket: ISocketIOContext; const aRoom, aEventName, aJSONArray: string; aCallback: TSocketIOCallbackRef; const aOnError: TSocketIOError);
{$IFDEF SUPEROBJECT}
function WriteSocketIOEventSync(const ASocket: ISocketIOContext; const aRoom, aEventName, aJSONArray: string; aMaxwait_ms: Cardinal = INFINITE): ISuperObject; function WriteSocketIOEventSync(const ASocket: ISocketIOContext; const aRoom, aEventName, aJSONArray: string; aMaxwait_ms: Cardinal = INFINITE): ISuperObject;
{$ENDIF}
procedure WriteSocketIOResult(const ASocket: ISocketIOContext; aRequestMsgNr: Integer; const aRoom, aData: string); procedure WriteSocketIOResult(const ASocket: ISocketIOContext; aRequestMsgNr: Integer; const aRoom, aData: string);
procedure ProcessSocketIO_XHR(const aGUID: string; const aStrmRequest, aStrmResponse: TStream); procedure ProcessSocketIO_XHR(const aGUID: string; const aStrmRequest, aStrmResponse: TStream);
@ -237,14 +216,13 @@ type
procedure FreeConnection(const ASocket: ISocketIOContext);overload; procedure FreeConnection(const ASocket: ISocketIOContext);overload;
property OnSocketIOMsg : TSocketIOMsg read FOnSocketIOMsg write FOnSocketIOMsg; property OnSocketIOMsg : TSocketIOMsg read FOnSocketIOMsg write FOnSocketIOMsg;
{$IFDEF SUPEROBJECT}
property OnSocketIOJson : TSocketIOMsgJSON read FOnSocketIOJson write FOnSocketIOJson; property OnSocketIOJson : TSocketIOMsgJSON read FOnSocketIOJson write FOnSocketIOJson;
{$ENDIF}
procedure OnEvent (const aEventName: string; const aCallback: TSocketIOEvent); procedure OnEvent (const aEventName: string; const aCallback: TSocketIOEvent);
procedure OnConnection(const aCallback: TSocketIONotify); procedure OnConnection(const aCallback: TSocketIONotify);
procedure OnDisconnect(const aCallback: TSocketIONotify); procedure OnDisconnect(const aCallback: TSocketIONotify);
property OnEventError: TSocketIOEventError read FOnEventError write FOnEventError; property OnEventError: TSocketIOEventError read FOnEventError write FOnEventError;
property DefaultErrorCallback: TSocketIOError read FDefaultErrorCallback write FDefaultErrorCallback;
procedure EnumerateSockets(const aEachSocketCallback: TSocketIONotify); procedure EnumerateSockets(const aEachSocketCallback: TSocketIONotify);
end; end;
@ -252,29 +230,15 @@ type
TIdSocketIOHandling = class(TIdBaseSocketIOHandling) TIdSocketIOHandling = class(TIdBaseSocketIOHandling)
public public
procedure Send(const aMessage: string; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil); procedure Send(const aMessage: string; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);
procedure Emit(const aEventName: string; const aData: string; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);overload;
{$IFDEF SUPEROBJECT}
procedure Emit(const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);overload; procedure Emit(const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);overload;
function EmitSync(const aEventName: string; const aData: ISuperObject; aMaxwait_ms: Cardinal = INFINITE): ISuperobject; function EmitSync(const aEventName: string; const aData: ISuperObject; aMaxwait_ms: Cardinal = INFINITE): ISuperobject;
//procedure Emit(const aEventName: string; const aData: string; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);overload; //procedure Emit(const aEventName: string; const aData: string; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);overload;
{$ENDIF}
end; end;
{$IFNDEF SUPEROBJECT}
function SO(const S:string):string; inline;
{$ENDIF}
implementation implementation
uses uses
IdServerWebsocketContext, IdHTTPWebsocketClient; StrUtils, IdServerWebsocketContext, IdHTTPWebsocketClient, Windows;
{$IFNDEF SUPEROBJECT}
function SO(const S:string):string; inline;
begin
Result := S;
end;
{$ENDIF}
procedure TIdBaseSocketIOHandling.AfterConstruction; procedure TIdBaseSocketIOHandling.AfterConstruction;
begin begin
@ -540,7 +504,8 @@ begin
FOnDisconnectList.Add(aCallback); FOnDisconnectList.Add(aCallback);
end; end;
procedure TIdBaseSocketIOHandling.OnEvent(const aEventName: string; const aCallback: TSocketIOEvent); procedure TIdBaseSocketIOHandling.OnEvent(const aEventName: string;
const aCallback: TSocketIOEvent);
var list: TSocketIOEventList; var list: TSocketIOEventList;
begin begin
if not FOnEventList.TryGetValue(aEventName, list) then if not FOnEventList.TryGetValue(aEventName, list) then
@ -560,91 +525,31 @@ begin
TSocketIOContext(ASocket).FContext.Connection.Disconnect; TSocketIOContext(ASocket).FContext.Connection.Disconnect;
end; 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 var
name: string;
{$IFNDEF SUPEROBJECT}
args: string;
{$ELSE}
args: TSuperArray;
json: ISuperObject; json: ISuperObject;
// socket: TSocketIOContext; name: string;
{$ENDIF} args: TSuperArray;
list: TSocketIOEventList; list: TSocketIOEventList;
event: TSocketIOEvent; event: TSocketIOEvent;
callback: ISocketIOCallback; callback: ISocketIOCallback;
// socket: TSocketIOContext;
{$IFNDEF SUPEROBJECT}
function _GetJsonMember(const aText:string; const iName:string):string;
var xs,xe,ctn:Integer;
begin
// Based on json formated content
Result := '';
xs := Pos('"'+iName+'"',aText);
if xs=0 then Exit;
xs := PosEx(':',aText,xs);
if xs=0 then Exit;
//
inc(xs);
while (xs<=length(aText)) and (aText[xs] in [' ',#13,#10,#8,#9]) do inc(xs);
if xs>=length(aText) then Exit;
//
if aText[xs]='[' then
begin
xe := xs+1; ctn := 1;
while (xe<=length(aText)) do
begin
if aText[xe]='[' then inc(ctn);
if aText[xe]=']' then dec(ctn);
if ctn=0 then break;
inc(xe);
end;
if ctn=0 then
Result := Copy(aText,xs,xe-xs+1);
end
else
if aText[xs]='{' then
begin
xe := xs+1; ctn := 1;
while (xe<=length(aText)) do
begin
if aText[xe]='{' then inc(ctn);
if aText[xe]='}' then dec(ctn);
if ctn=0 then break;
inc(xe);
end;
if ctn=0 then
Result := Copy(aText,xs,xe-xs+1);
end
else
if aText[xs]='"' then
begin
xe := PosEx('"',aText,xs+1);
if xe=0 then Exit;
Result := Copy(aText,xs+1,xe-xs-1);
end;
end;
{$ENDIF}
begin begin
//'5:' [message id ('+')] ':' [message endpoint] ':' [json encoded event] //'5:' [message id ('+')] ':' [message endpoint] ':' [json encoded event]
//5::/chat:{"name":"my other event","args":[{"my":"data"}]} //5::/chat:{"name":"my other event","args":[{"my":"data"}]}
//5:1+:/chat:{"name":"GetLocations","args":[""]} //5:1+:/chat:{"name":"GetLocations","args":[""]}
{$IFNDEF SUPEROBJECT}
name := _GetJsonMember(aText,'name'); //"my other event
args := _GetJsonMember(aText,'args'); //[{"my":"data"}]
{$ELSE}
json := SO(aText); json := SO(aText);
// args := nil; // args := nil;
try try
name := json.S['name']; //"my other event name := json.S['name']; //"my other event
args := json.A['args']; //[{"my":"data"}] args := json.A['args']; //[{"my":"data"}]
{$ENDIF}
if FOnEventList.TryGetValue(name, list) then if FOnEventList.TryGetValue(name, list) then
begin begin
if list.Count = 0 then if list.Count = 0 then
raise EIdSocketIoUnhandledMessage.Create(aText); raise EIdSocketIoUnhandledMessage.Create('No listener available for event: ' + aText);
// socket := FConnections.Items[AContext]; // socket := FConnections.Items[AContext];
if aHasCallback then if aHasCallback then
@ -657,28 +562,21 @@ begin
event(AContext, args, callback); event(AContext, args, callback);
except on E:Exception do except on E:Exception do
if Assigned(OnEventError) then if Assigned(OnEventError) then
OnEventError(AContext, callback, e) OnEventError(AContext, callback, e) //custom error handling (send different error back to remote client/context/initiator?)
else else
if callback <> nil then if callback <> nil then
{$IFNDEF SUPEROBJECT}
callback.SendResponse('Error');
{$ELSE}
callback.SendResponse( SO(['Error', SO(['msg', e.message])]).AsJSon ); callback.SendResponse( SO(['Error', SO(['msg', e.message])]).AsJSon );
{$ENDIF}
end; end;
finally finally
callback := nil; callback := nil;
end; end;
end end
else else
raise EIdSocketIoUnhandledMessage.Create(aText); raise EIdSocketIoUnhandledMessage.Create('No listeners registered for event: ' + aText);
{$IFDEF SUPEROBJECT}
finally finally
// args.Free; // args.Free;
json := nil; json := nil;
end; end;
{$ENDIF}
end; end;
procedure TIdBaseSocketIOHandling.ProcessHeatbeatRequest(const ASocket: ISocketIOContext; const aText: string); procedure TIdBaseSocketIOHandling.ProcessHeatbeatRequest(const ASocket: ISocketIOContext; const aText: string);
@ -846,6 +744,7 @@ procedure TIdBaseSocketIOHandling.ProcessSocketIORequest(
var var
str, smsg, schannel, sdata: string; str, smsg, schannel, sdata: string;
sErrorType, sErrorMsg: string;
imsg: Integer; imsg: Integer;
bCallback: Boolean; bCallback: Boolean;
// socket: TSocketIOContext; // socket: TSocketIOContext;
@ -853,9 +752,7 @@ var
callbackref: TSocketIOCallbackRef; callbackref: TSocketIOCallbackRef;
callbackobj: ISocketIOCallback; callbackobj: ISocketIOCallback;
errorref: TSocketIOError; errorref: TSocketIOError;
{$IFDEF SUPEROBJECT}
error: ISuperObject; error: ISuperObject;
{$ENDIF}
socket: TSocketIOContext; socket: TSocketIOContext;
begin begin
if ASocket = nil then Exit; if ASocket = nil then Exit;
@ -928,12 +825,8 @@ begin
except except
on E:Exception do on E:Exception do
begin begin
{$IFDEF SUPEROBJECT}
if not callbackobj.IsResponseSend then if not callbackobj.IsResponseSend then
callbackobj.SendResponse( SO(['Error', SO(['Type', e.ClassName, 'Message', e.Message])]).AsJSon ); callbackobj.SendResponse( SO(['Error', SO(['Type', e.ClassName, 'Message', e.Message])]).AsJSon );
{$ELSE}
//TODO
{$ENDIF}
end; end;
end; end;
finally finally
@ -951,7 +844,6 @@ begin
//4:1::{"a":"b"} //4:1::{"a":"b"}
else if StartsStr('4:', str) then else if StartsStr('4:', str) then
begin begin
{$IFDEF SUPEROBJECT}
if Assigned(OnSocketIOJson) then if Assigned(OnSocketIOJson) then
begin begin
if bCallback then if bCallback then
@ -975,7 +867,6 @@ begin
OnSocketIOJson(ASocket, SO(sdata), nil); //, imsg, bCallback); OnSocketIOJson(ASocket, SO(sdata), nil); //, imsg, bCallback);
end end
else else
{$ENDIF}
raise EIdSocketIoUnhandledMessage.Create(str); raise EIdSocketIoUnhandledMessage.Create(str);
end end
//(5) Event //(5) Event
@ -990,7 +881,7 @@ begin
ProcessEvent(socket, sdata, imsg, bCallback); ProcessEvent(socket, sdata, imsg, bCallback);
except except
on e:exception do on e:exception do
// raise
end end
end end
//(6) ACK //(6) ACK
@ -1002,28 +893,47 @@ begin
imsg := StrToIntDef(smsg, 0); imsg := StrToIntDef(smsg, 0);
sData := Copy(sdata, Pos('+', sData)+1, Length(sData)); sData := Copy(sdata, Pos('+', sData)+1, Length(sData));
TSocketIOContext(ASocket).FPendingMessages.Remove(imsg); error := nil;
if FSocketIOErrorRef.TryGetValue(imsg, errorref) then
begin
FSocketIOErrorRef.Remove(imsg);
//'[{"Error":{"Message":"Operation aborted","Type":"EAbort"}}]' //'[{"Error":{"Message":"Operation aborted","Type":"EAbort"}}]'
{$IFDEF SUPEROBJECT}
if ContainsText(sdata, '{"Error":') then if ContainsText(sdata, '{"Error":') then
begin begin
error := SO(sdata); error := SO(sdata);
if error.IsType(stArray) then if error.IsType(stArray) then
error := error.O['0']; error := error.O['0'];
error := error.O['Error']; error := error.O['Error'];
sErrorType := error.S['Type'];
if error.S['Message'] <> '' then if error.S['Message'] <> '' then
errorref(ASocket, error.S['Type'], error.S['Message']) sErrorMsg := error.S['Message']
else if error.S['msg'] <> '' then
sErrorMsg := error.S['msg']
else else
errorref(ASocket, 'Unknown', sdata); begin
sErrorMsg := sdata;
sErrorType := 'Unknown';
end;
end;
TSocketIOContext(ASocket).FPendingMessages.Remove(imsg);
if FSocketIOErrorRef.TryGetValue(imsg, errorref) then
begin
FSocketIOErrorRef.Remove(imsg);
if error <> nil then
begin
errorref(ASocket, sErrorType, sErrorMsg);
FSocketIOEventCallback.Remove(imsg); FSocketIOEventCallback.Remove(imsg);
FSocketIOEventCallbackRef.Remove(imsg); FSocketIOEventCallbackRef.Remove(imsg);
Exit; Exit;
end; end;
{$ENDIF} end;
//no error handler? than always raise an exception so programmer gets notified (and can log it using exception logger)
if error <> nil then
begin
if Assigned(DefaultErrorCallback) then
DefaultErrorCallback(ASocket, sErrorType, sErrorMsg)
else
raise ESocketIOException.CreateFmt('Server side error "%s": %s', [sErrorType, sErrorMsg]);
end; end;
if FSocketIOEventCallback.TryGetValue(imsg, callback) then if FSocketIOEventCallback.TryGetValue(imsg, callback) then
@ -1163,7 +1073,6 @@ begin
WriteString(ASocket, sresult); WriteString(ASocket, sresult);
end; end;
{$IFDEF SUPEROBJECT}
function TIdBaseSocketIOHandling.WriteSocketIOEventSync(const ASocket: ISocketIOContext; const aRoom, aEventName, function TIdBaseSocketIOHandling.WriteSocketIOEventSync(const ASocket: ISocketIOContext; const aRoom, aEventName,
aJSONArray: string; aMaxwait_ms: Cardinal = INFINITE): ISuperObject; aJSONArray: string; aMaxwait_ms: Cardinal = INFINITE): ISuperObject;
var var
@ -1248,7 +1157,7 @@ begin
promise.Free; promise.Free;
end; end;
end; end;
{$ENDIF}
procedure TIdBaseSocketIOHandling.WriteSocketIOJSON(const ASocket: ISocketIOContext; procedure TIdBaseSocketIOHandling.WriteSocketIOJSON(const ASocket: ISocketIOContext;
const aRoom, aJSON: string; aCallback: TSocketIOCallbackRef = nil; const aOnError: TSocketIOError = nil); const aRoom, aJSON: string; aCallback: TSocketIOCallbackRef = nil; const aOnError: TSocketIOError = nil);
var var
@ -1405,7 +1314,8 @@ begin
inherited; inherited;
end; 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 begin
Assert(FHandling <> nil); Assert(FHandling <> nil);
@ -1421,15 +1331,14 @@ begin
end; end;
end; end;
{$IFDEF SUPEROBJECT} procedure TSocketIOContext.EmitEvent(const aEventName: string; const aData: ISuperObject;
procedure TSocketIOContext.EmitEvent(const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError); const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
begin begin
if aData <> nil then if aData <> nil then
EmitEvent(aEventName, aData.AsJSon, aCallback, aOnError) EmitEvent(aEventName, aData.AsJSon, aCallback, aOnError)
else else
EmitEvent(aEventName, '', aCallback, aOnError); EmitEvent(aEventName, '', aCallback, aOnError);
end; end;
{$ENDIF}
function TSocketIOContext.GetCustomData: TObject; function TSocketIOContext.GetCustomData: TObject;
begin begin
@ -1498,7 +1407,8 @@ begin
Result := (FClient as TIdHTTPWebsocketClient).WSResourceName Result := (FClient as TIdHTTPWebsocketClient).WSResourceName
end; 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 begin
if not Assigned(aCallback) then if not Assigned(aCallback) then
FHandling.WriteSocketIOMsg(Self, '', aData) FHandling.WriteSocketIOMsg(Self, '', aData)
@ -1512,7 +1422,6 @@ begin
end; end;
end; end;
{$IFDEF SUPEROBJECT}
procedure TSocketIOContext.SendJSON(const aJSON: ISuperObject; procedure TSocketIOContext.SendJSON(const aJSON: ISuperObject;
const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError); const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
begin begin
@ -1527,7 +1436,7 @@ begin
end, aOnError); end, aOnError);
end; end;
end; end;
{$ENDIF}
procedure TSocketIOContext.ServerContextDestroy(AContext: TIdContext); procedure TSocketIOContext.ServerContextDestroy(AContext: TIdContext);
begin begin
Self.Context := nil; Self.Context := nil;
@ -1636,7 +1545,6 @@ end;
{ TIdSocketIOHandling } { TIdSocketIOHandling }
{$IFDEF SUPEROBJECT}
procedure TIdSocketIOHandling.Emit(const aEventName: string; procedure TIdSocketIOHandling.Emit(const aEventName: string;
const aData: ISuperObject; const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError); const aData: ISuperObject; const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
var var
@ -1737,52 +1645,6 @@ begin
Result := WriteSocketIOEventSync(firstcontext, ''{no room}, aEventName, jsonarray, aMaxwait_ms); Result := WriteSocketIOEventSync(firstcontext, ''{no room}, aEventName, jsonarray, aMaxwait_ms);
end; end;
{$ENDIF}
procedure TIdSocketIOHandling.Emit(const aEventName: string;
const aData: string; const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
var context: ISocketIOContext; isendcount: Integer;
begin
Lock;
try
isendcount := 0;
//note: client has single connection?
for context in FConnections.Values do
begin
if context.IsDisconnected then Continue;
if not Assigned(aCallback) then
WriteSocketIOEvent(context, ''{no room}, aEventName, aData, nil, nil)
else
WriteSocketIOEventRef(context, ''{no room}, aEventName, aData,
procedure(const aData: string)
begin
aCallback(context, SO(aData), nil);
end, aOnError);
Inc(isendcount);
end;
for context in FConnectionsGUID.Values do
begin
if context.IsDisconnected then Continue;
if not Assigned(aCallback) then
WriteSocketIOEvent(context, ''{no room}, aEventName, aData, nil, nil)
else
WriteSocketIOEventRef(context, ''{no room}, aEventName, aData,
procedure(const aData: string)
begin
aCallback(context, SO(aData), nil);
end, aOnError);
Inc(isendcount);
end;
if isendcount = 0 then
raise EIdSocketIoUnhandledMessage.Create('Cannot emit: no socket.io connections!');
finally
UnLock;
end;
end;
procedure TIdSocketIOHandling.Send(const aMessage: string; procedure TIdSocketIOHandling.Send(const aMessage: string;
const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError); const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
@ -1831,7 +1693,6 @@ begin
end; end;
end; end;
{ TSocketIOPromise } { TSocketIOPromise }
procedure TSocketIOPromise.AfterConstruction; procedure TSocketIOPromise.AfterConstruction;

127
IdWebsocketServer.pas
View file

@ -1,56 +1,35 @@
unit IdWebsocketServer; unit IdWebsocketServer;
interface interface
{$I wsdefines.pas}
uses uses
Classes IdServerWebsocketHandling, IdServerSocketIOHandling, IdServerWebsocketContext,
, IdStreamVCL IdHTTPServer, IdContext, IdCustomHTTPServer, Classes, IdIOHandlerWebsocket, IdGlobal, IdServerIOHandler;
, IdGlobal
, IdWinsock2
, IdHTTPServer
, IdContext
, IdCustomHTTPServer
, IdHTTPWebBrokerBridge
//
, IdIOHandlerWebsocket
, IdServerIOHandlerWebsocket
, IdServerWebsocketContext
, IdServerWebsocketHandling
, IdServerSocketIOHandling
;
type type
TWebsocketMessageText = procedure(const AContext: TIdServerWSContext; const aText: string) of object; TWebsocketMessageText = procedure(const AContext: TIdServerWSContext; const aText: string) of object;
TWebsocketMessageBin = procedure(const AContext: TIdServerWSContext; const aData: TStream) of object; TWebsocketMessageBin = procedure(const AContext: TIdServerWSContext; const aData: TStream) of object;
{$IFDEF WEBSOCKETBRIDGE}
TMyIdHttpWebBrokerBridge = class(TidHttpWebBrokerBridge)
published
property OnCreatePostStream;
property OnDoneWithPostStream;
property OnCommandGet;
end;
{$ENDIF}
{$IFDEF WEBSOCKETBRIDGE}
TIdWebsocketServer = class(TMyIdHttpWebBrokerBridge)
{$ELSE}
TIdWebsocketServer = class(TIdHTTPServer) TIdWebsocketServer = class(TIdHTTPServer)
{$ENDIF}
private private
FSocketIO: TIdServerSocketIOHandling_Ext; FSocketIO: TIdServerSocketIOHandling_Ext;
FOnMessageText: TWebsocketMessageText; FOnMessageText: TWebsocketMessageText;
FOnMessageBin: TWebsocketMessageBin; FOnMessageBin: TWebsocketMessageBin;
FWriteTimeout: Integer; FWriteTimeout: Integer;
FUseSSL: boolean;
function GetSocketIO: TIdServerSocketIOHandling; function GetSocketIO: TIdServerSocketIOHandling;
procedure SetWriteTimeout(const Value: Integer); procedure SetWriteTimeout(const Value: Integer);
function GetIOHandler: TIdServerIOHandler;
protected protected
function WebSocketCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo):boolean; procedure Startup; override;
procedure DoCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); override; procedure DetermineSSLforPort(APort: TIdPort; var VUseSSL: Boolean);
procedure DoCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo;
AResponseInfo: TIdHTTPResponseInfo); override;
procedure ContextCreated(AContext: TIdContext); override; procedure ContextCreated(AContext: TIdContext); override;
procedure ContextDisconnected(AContext: TIdContext); override; procedure ContextDisconnected(AContext: TIdContext); override;
procedure WebsocketUpgradeRequest(const AContext: TIdServerWSContext; ARequestInfo: TIdHTTPRequestInfo; var Accept:boolean); virtual; procedure WebsocketChannelRequest(const AContext: TIdServerWSContext; aType: TWSDataType; const aStrmRequest, aStrmResponse: TMemoryStream);
procedure WebsocketChannelRequest(const AContext: TIdServerWSContext; var aType:TWSDataType; const aStrmRequest, aStrmResponse: TMemoryStream); virtual;
public public
procedure AfterConstruction; override; procedure AfterConstruction; override;
destructor Destroy; override; destructor Destroy; override;
@ -61,13 +40,18 @@ type
property OnMessageText: TWebsocketMessageText read FOnMessageText write FOnMessageText; property OnMessageText: TWebsocketMessageText read FOnMessageText write FOnMessageText;
property OnMessageBin : TWebsocketMessageBin read FOnMessageBin write FOnMessageBin; property OnMessageBin : TWebsocketMessageBin read FOnMessageBin write FOnMessageBin;
property IOHandler: TIdServerIOHandler read GetIOHandler write SetIOHandler;
property SocketIO: TIdServerSocketIOHandling read GetSocketIO; property SocketIO: TIdServerSocketIOHandling read GetSocketIO;
published published
property WriteTimeout: Integer read FWriteTimeout write SetWriteTimeout default 2000; property WriteTimeout: Integer read FWriteTimeout write SetWriteTimeout default 2000;
property UseSSL: boolean read FUseSSL write FUseSSL;
end; end;
implementation implementation
uses
IdServerIOHandlerWebsocket, IdStreamVCL, Windows, IdWinsock2, IdSSLOpenSSL, IdSSL, IdThread; //, idIOHandler, idssl;
{ TIdWebsocketServer } { TIdWebsocketServer }
procedure TIdWebsocketServer.AfterConstruction; procedure TIdWebsocketServer.AfterConstruction;
@ -77,9 +61,6 @@ begin
FSocketIO := TIdServerSocketIOHandling_Ext.Create; FSocketIO := TIdServerSocketIOHandling_Ext.Create;
ContextClass := TIdServerWSContext; ContextClass := TIdServerWSContext;
if IOHandler = nil then
IOHandler := TIdServerIOHandlerWebsocket.Create(Self);
FWriteTimeout := 2 * 1000; //2s FWriteTimeout := 2 * 1000; //2s
end; end;
@ -105,23 +86,71 @@ begin
FSocketIO.Free; FSocketIO.Free;
end; end;
function TIdWebsocketServer.WebSocketCommandGet(AContext: TIdContext; procedure TIdWebsocketServer.DetermineSSLforPort(APort: TIdPort; var VUseSSL: Boolean);
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo):boolean; //var
// thread: TIdThreadWithTask;
// ctx: TIdServerWSContext;
begin begin
(AContext as TIdServerWSContext).OnWebSocketUpgrade := Self.WebSocketUpgradeRequest; VUseSSL := IOHandler.InheritsFrom(TIdServerIOHandlerSSLBase);
(AContext as TIdServerWSContext).OnCustomChannelExecute := Self.WebsocketChannelRequest;
(AContext as TIdServerWSContext).SocketIO := FSocketIO;
Result := TIdServerWebsocketHandling.ProcessServerCommandGet(AContext as TIdServerWSContext, ARequestInfo, AResponseInfo); {$message warn 'todo: no ssl for localhost (testing, server IPC, etc)?'}
(*
//
if TThread.CurrentThread is TIdThreadWithTask then
begin
thread := TThread.CurrentThread as TIdThreadWithTask;
ctx := thread.Task as TIdServerWSContext;
//yarn := thread.Task.Yarn as TIdYarnOfThread;
if ctx.Binding.PeerIP = '127.0.0.1' then
VUseSSL := false;
end;
*)
end; end;
procedure TIdWebsocketServer.DoCommandGet(AContext: TIdContext; procedure TIdWebsocketServer.DoCommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
begin begin
if not WebSocketCommandGet(AContext,ARequestInfo,AResponseInfo) then (AContext as TIdServerWSContext).OnCustomChannelExecute := Self.WebsocketChannelRequest;
(AContext as TIdServerWSContext).SocketIO := FSocketIO;
if not TIdServerWebsocketHandling.ProcessServerCommandGet(AContext as TIdServerWSContext, ARequestInfo, AResponseInfo) then
inherited DoCommandGet(AContext, ARequestInfo, AResponseInfo); inherited DoCommandGet(AContext, ARequestInfo, AResponseInfo);
end; end;
function TIdWebsocketServer.GetIOHandler: TIdServerIOHandler;
begin
Result := inherited IOHandler;
if Result = nil then
begin
if UseSSL then
begin
Result := TIdServerIOHandlerWebsocketSSL.Create(Self);
with Result as TIdServerIOHandlerWebsocketSSL do
begin
//note: custom certificate files must be set by user, e.g. in datamodule OnCreate:
//FHttpServer := TIdWebsocketServer.Create;
//FHttpServer.UseSSL := True;
//with FHttpServer.IOHandler as TIdServerIOHandlerWebsocketSSL do
// SSLOptions.RootCertFile := 'root.cer';
// SSLOptions.CertFile := 'your_cert.cer';
// SSLOptions.KeyFile := 'key.pem';
SSLOptions.Method := sslvSSLv23;
SSLOptions.Mode := sslmServer;
OnQuerySSLPort := DetermineSSLforPort;
end;
end
else
Result := TIdServerIOHandlerWebsocket.Create(Self);
inherited IOHandler := Result;
end;
end;
function TIdWebsocketServer.GetSocketIO: TIdServerSocketIOHandling; function TIdWebsocketServer.GetSocketIO: TIdServerSocketIOHandling;
begin begin
Result := FSocketIO; Result := FSocketIO;
@ -139,7 +168,7 @@ begin
begin begin
ctx := TIdServerWSContext(l.Items[i]); ctx := TIdServerWSContext(l.Items[i]);
Assert(ctx is TIdServerWSContext); Assert(ctx is TIdServerWSContext);
if ctx.IOHandler.IsWebsocket and if ctx.WebsocketImpl.IsWebsocket and
not ctx.IsSocketIO not ctx.IsSocketIO
then then
ctx.IOHandler.Write(aText); ctx.IOHandler.Write(aText);
@ -154,12 +183,14 @@ begin
FWriteTimeout := Value; FWriteTimeout := Value;
end; end;
procedure TIdWebsocketServer.WebsocketUpgradeRequest(const AContext: TIdServerWSContext; ARequestInfo: TIdHTTPRequestInfo; var Accept:boolean); procedure TIdWebsocketServer.Startup;
begin begin
Accept := True; inherited;
end; end;
procedure TIdWebsocketServer.WebsocketChannelRequest(const AContext: TIdServerWSContext; var aType:TWSDataType; const aStrmRequest,aStrmResponse: TMemoryStream); procedure TIdWebsocketServer.WebsocketChannelRequest(
const AContext: TIdServerWSContext; aType: TWSDataType; const aStrmRequest,
aStrmResponse: TMemoryStream);
var s: string; var s: string;
begin begin
if aType = wdtText then if aType = wdtText then
@ -191,7 +222,7 @@ begin
begin begin
ctx := TIdServerWSContext(l.Items[i]); ctx := TIdServerWSContext(l.Items[i]);
Assert(ctx is TIdServerWSContext); Assert(ctx is TIdServerWSContext);
if ctx.IOHandler.IsWebsocket and if ctx.WebsocketImpl.IsWebsocket and
not ctx.IsSocketIO not ctx.IsSocketIO
then then
ctx.IOHandler.Write(bytes); ctx.IOHandler.Write(bytes);

7
README.md
View file

@ -1,10 +1,3 @@
# 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 # DelphiWebsockets
Websockets and Socket.io for Delphi Websockets and Socket.io for Delphi

3
wsdefines.pas
View file

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