354 lines
13 KiB
ObjectPascal
354 lines
13 KiB
ObjectPascal
unit IdServerWebsocketHandling;
|
|
interface
|
|
{$I wsdefines.pas}
|
|
uses
|
|
Classes, StrUtils, SysUtils, DateUtils
|
|
, IdCoderMIME
|
|
, IdThread
|
|
, IdContext
|
|
, IdCustomHTTPServer
|
|
{$IF CompilerVersion <= 21.0} //D2010
|
|
, IdHashSHA1
|
|
{$else}
|
|
, IdHashSHA //XE3 etc
|
|
{$IFEND}
|
|
, IdServerSocketIOHandling
|
|
//
|
|
, IdSocketIOHandling
|
|
, IdServerBaseHandling
|
|
, IdServerWebsocketContext
|
|
, IdIOHandlerWebsocket
|
|
;
|
|
|
|
type
|
|
TIdServerSocketIOHandling_Ext = class(TIdServerSocketIOHandling)
|
|
end;
|
|
|
|
TIdServerWebsocketHandling = class(TIdServerBaseHandling)
|
|
protected
|
|
class procedure DoWSExecute(AThread: TIdContext; aSocketIOHandler: TIdServerSocketIOHandling_Ext);virtual;
|
|
class procedure HandleWSMessage(AContext: TIdServerWSContext; var aType: TWSDataType;
|
|
aRequestStrm, aResponseStrm: TMemoryStream;
|
|
aSocketIOHandler: TIdServerSocketIOHandling_Ext);virtual;
|
|
public
|
|
class function ProcessServerCommandGet(AThread: TIdServerWSContext;
|
|
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo): Boolean;
|
|
|
|
class function CurrentSocket: ISocketIOContext;
|
|
end;
|
|
|
|
implementation
|
|
|
|
{ TIdServerWebsocketHandling }
|
|
|
|
class function TIdServerWebsocketHandling.CurrentSocket: ISocketIOContext;
|
|
var
|
|
thread: TIdThreadWithTask;
|
|
context: TIdServerWSContext;
|
|
begin
|
|
if not (TThread.Currentthread is TIdThreadWithTask) then Exit(nil);
|
|
thread := TThread.Currentthread as TIdThreadWithTask;
|
|
if not (thread.Task is TIdServerWSContext) then Exit(nil);
|
|
context := thread.Task as TIdServerWSContext;
|
|
Result := context.SocketIO.GetSocketIOContext(context);
|
|
end;
|
|
|
|
class procedure TIdServerWebsocketHandling.DoWSExecute(AThread: TIdContext; aSocketIOHandler: TIdServerSocketIOHandling_Ext);
|
|
var
|
|
strmRequest, strmResponse: TMemoryStream;
|
|
wscode: TWSDataCode;
|
|
wstype: TWSDataType;
|
|
context: TIdServerWSContext;
|
|
tstart: TDateTime;
|
|
begin
|
|
context := nil;
|
|
try
|
|
context := AThread as TIdServerWSContext;
|
|
//todo: make seperate function + do it after first real write (not header!)
|
|
if context.IOHandler.BusyUpgrading then
|
|
begin
|
|
context.IOHandler.IsWebsocket := True;
|
|
context.IOHandler.BusyUpgrading := False;
|
|
end;
|
|
//initial connect
|
|
if context.IsSocketIO then
|
|
begin
|
|
Assert(aSocketIOHandler <> nil);
|
|
aSocketIOHandler.WriteConnect(context);
|
|
end;
|
|
AThread.Connection.Socket.UseNagle := False; //no 200ms delay!
|
|
|
|
tstart := Now;
|
|
context := AThread as TIdServerWSContext;
|
|
|
|
while AThread.Connection.Connected do
|
|
begin
|
|
if context.IOHandler.HasData or
|
|
(AThread.Connection.IOHandler.InputBuffer.Size > 0) or
|
|
AThread.Connection.IOHandler.Readable(1 * 1000) then //wait 5s, else ping the client(!)
|
|
begin
|
|
tstart := Now;
|
|
|
|
strmResponse := TMemoryStream.Create;
|
|
strmRequest := TMemoryStream.Create;
|
|
try
|
|
|
|
strmRequest.Position := 0;
|
|
//first is the type: text or bin
|
|
wscode := TWSDataCode(context.IOHandler.ReadLongWord);
|
|
//then the length + data = stream
|
|
context.IOHandler.ReadStream(strmRequest);
|
|
strmRequest.Position := 0;
|
|
//ignore ping/pong messages
|
|
if wscode in [wdcPing, wdcPong] then
|
|
begin
|
|
if wscode = wdcPing then
|
|
context.IOHandler.WriteData(nil, wdcPong);
|
|
Continue;
|
|
end;
|
|
|
|
if wscode = wdcText
|
|
then wstype := wdtText
|
|
else wstype := wdtBinary;
|
|
|
|
HandleWSMessage(context, wstype, strmRequest, strmResponse, aSocketIOHandler);
|
|
|
|
//write result back (of the same type: text or bin)
|
|
if strmResponse.Size > 0 then
|
|
begin
|
|
if wstype = wdtText
|
|
then context.IOHandler.Write(strmResponse, wdtText)
|
|
else context.IOHandler.Write(strmResponse, wdtBinary)
|
|
end
|
|
else context.IOHandler.WriteData(nil, wdcPing);
|
|
finally
|
|
strmRequest.Free;
|
|
strmResponse.Free;
|
|
end;
|
|
end
|
|
//ping after 5s idle
|
|
else if SecondsBetween(Now, tstart) > 5 then
|
|
begin
|
|
tstart := Now;
|
|
//ping
|
|
if context.IsSocketIO then
|
|
begin
|
|
//context.SocketIOPingSend := True;
|
|
Assert(aSocketIOHandler <> nil);
|
|
aSocketIOHandler.WritePing(context);
|
|
end
|
|
else
|
|
context.IOHandler.WriteData(nil, wdcPing);
|
|
end;
|
|
|
|
end;
|
|
finally
|
|
if context.IsSocketIO then
|
|
begin
|
|
Assert(aSocketIOHandler <> nil);
|
|
aSocketIOHandler.WriteDisConnect(context);
|
|
end;
|
|
context.IOHandler.Clear;
|
|
AThread.Data := nil;
|
|
end;
|
|
end;
|
|
|
|
class procedure TIdServerWebsocketHandling.HandleWSMessage(AContext: TIdServerWSContext; var aType:TWSDataType; aRequestStrm, aResponseStrm: TMemoryStream; aSocketIOHandler: TIdServerSocketIOHandling_Ext);
|
|
begin
|
|
if AContext.IsSocketIO then
|
|
begin
|
|
aRequestStrm.Position := 0;
|
|
Assert(aSocketIOHandler <> nil);
|
|
aSocketIOHandler.ProcessSocketIORequest(AContext, aRequestStrm);
|
|
end
|
|
else if Assigned(AContext.OnCustomChannelExecute) then
|
|
AContext.OnCustomChannelExecute(AContext, aType, aRequestStrm, aResponseStrm);
|
|
end;
|
|
|
|
class function TIdServerWebsocketHandling.ProcessServerCommandGet(
|
|
AThread: TIdServerWSContext; ARequestInfo: TIdHTTPRequestInfo;
|
|
AResponseInfo: TIdHTTPResponseInfo): Boolean;
|
|
var
|
|
Accept: Boolean;
|
|
sValue, squid: string;
|
|
context: TIdServerWSContext;
|
|
hash: TIdHashSHA1;
|
|
guid: TGUID;
|
|
begin
|
|
(* GET /chat HTTP/1.1
|
|
Host: server.example.com
|
|
Upgrade: websocket
|
|
Connection: Upgrade
|
|
Sec-WebSocket-Key: dGhlIHNhbXBsZSBub25jZQ==
|
|
Origin: http://example.com
|
|
Sec-WebSocket-Protocol: chat, superchat
|
|
Sec-WebSocket-Version: 13 *)
|
|
|
|
(* GET ws://echo.websocket.org/?encoding=text HTTP/1.1
|
|
Origin: http://websocket.org
|
|
Cookie: __utma=99as
|
|
Connection: Upgrade
|
|
Host: echo.websocket.org
|
|
Sec-WebSocket-Key: uRovscZjNol/umbTt5uKmw==
|
|
Upgrade: websocket
|
|
Sec-WebSocket-Version: 13 *)
|
|
|
|
//Connection: Upgrade
|
|
if not ContainsText(ARequestInfo.Connection, 'Upgrade') then //Firefox uses "keep-alive, Upgrade"
|
|
begin
|
|
//initiele ondersteuning voor socket.io
|
|
if SameText(ARequestInfo.document , '/socket.io/1/') then
|
|
begin
|
|
{
|
|
https://github.com/LearnBoost/socket.io-spec
|
|
The client will perform an initial HTTP POST request like the following
|
|
http://example.com/socket.io/1/
|
|
200: The handshake was successful.
|
|
The body of the response should contain the session id (sid) given to the client, followed by the heartbeat timeout, the connection closing timeout, and the list of supported transports separated by :
|
|
The absence of a heartbeat timeout ('') is interpreted as the server and client not expecting heartbeats.
|
|
For example 4d4f185e96a7b:15:10:websocket,xhr-polling.
|
|
}
|
|
AResponseInfo.ResponseNo := 200;
|
|
AResponseInfo.ResponseText := 'Socket.io connect OK';
|
|
|
|
CreateGUID(guid);
|
|
squid := GUIDToString(guid);
|
|
AResponseInfo.ContentText := squid +
|
|
':15:10:websocket,xhr-polling';
|
|
AResponseInfo.CloseConnection := False;
|
|
(AThread.SocketIO as TIdServerSocketIOHandling_Ext).NewConnection(AThread);
|
|
//(AThread.SocketIO as TIdServerSocketIOHandling_Ext).NewConnection(squid, AThread.Binding.PeerIP);
|
|
|
|
Result := True; //handled
|
|
end
|
|
//'/socket.io/1/xhr-polling/2129478544'
|
|
else if StartsText('/socket.io/1/xhr-polling/', ARequestInfo.document) then
|
|
begin
|
|
AResponseInfo.ContentStream := TMemoryStream.Create;
|
|
AResponseInfo.CloseConnection := False;
|
|
|
|
squid := Copy(ARequestInfo.Document, 1 + Length('/socket.io/1/xhr-polling/'), Length(ARequestInfo.document));
|
|
if ARequestInfo.CommandType = hcGET then
|
|
(AThread.SocketIO as TIdServerSocketIOHandling_Ext)
|
|
.ProcessSocketIO_XHR(squid, ARequestInfo.PostStream, AResponseInfo.ContentStream)
|
|
else if ARequestInfo.CommandType = hcPOST then
|
|
(AThread.SocketIO as TIdServerSocketIOHandling_Ext)
|
|
.ProcessSocketIO_XHR(squid, ARequestInfo.PostStream, nil); //no response expected with POST!
|
|
Result := True; //handled
|
|
end
|
|
else
|
|
Result := False; //NOT handled
|
|
end
|
|
else
|
|
begin
|
|
Result := True; //handled
|
|
context := AThread as TIdServerWSContext;
|
|
|
|
if Assigned(Context.OnWebSocketUpgrade) then
|
|
begin
|
|
Accept := True;
|
|
Context.OnWebSocketUpgrade(Context,ARequestInfo,Accept);
|
|
if not Accept then Abort;
|
|
end;
|
|
|
|
//Sec-WebSocket-Key: dGhlIHNhbXBsZSBub25jZQ==
|
|
sValue := ARequestInfo.RawHeaders.Values['sec-websocket-key'];
|
|
//"The value of this header field MUST be a nonce consisting of a randomly
|
|
// selected 16-byte value that has been base64-encoded"
|
|
if (sValue <> '') then
|
|
begin
|
|
if (Length(TIdDecoderMIME.DecodeString(sValue)) = 16) then
|
|
context.WebSocketKey := sValue
|
|
else
|
|
Abort; //invalid length
|
|
end
|
|
else
|
|
//important: key must exists, otherwise stop!
|
|
Abort;
|
|
|
|
(*
|
|
ws-URI = "ws:" "//" host [ ":" port ] path [ "?" query ]
|
|
wss-URI = "wss:" "//" host [ ":" port ] path [ "?" query ]
|
|
2. The method of the request MUST be GET, and the HTTP version MUST be at least 1.1.
|
|
For example, if the WebSocket URI is "ws://example.com/chat",
|
|
the first line sent should be "GET /chat HTTP/1.1".
|
|
3. The "Request-URI" part of the request MUST match the /resource
|
|
name/ defined in Section 3 (a relative URI) or be an absolute
|
|
http/https URI that, when parsed, has a /resource name/, /host/,
|
|
and /port/ that match the corresponding ws/wss URI.
|
|
*)
|
|
context.ResourceName := ARequestInfo.Document;
|
|
if ARequestInfo.UnparsedParams <> '' then
|
|
context.ResourceName := context.ResourceName + '?' +
|
|
ARequestInfo.UnparsedParams;
|
|
//seperate parts
|
|
context.Path := ARequestInfo.Document;
|
|
context.Query := ARequestInfo.UnparsedParams;
|
|
|
|
//Host: server.example.com
|
|
context.Host := ARequestInfo.RawHeaders.Values['host'];
|
|
//Origin: http://example.com
|
|
context.Origin := ARequestInfo.RawHeaders.Values['origin'];
|
|
//Cookie: __utma=99as
|
|
context.Cookie := ARequestInfo.RawHeaders.Values['cookie'];
|
|
|
|
//Sec-WebSocket-Version: 13
|
|
//"The value of this header field MUST be 13"
|
|
sValue := ARequestInfo.RawHeaders.Values['sec-websocket-version'];
|
|
if (sValue <> '') then
|
|
begin
|
|
context.WebSocketVersion := StrToIntDef(sValue, 0);
|
|
|
|
if context.WebSocketVersion < 13 then
|
|
Abort; //must be at least 13
|
|
end
|
|
else
|
|
Abort; //must exist
|
|
|
|
context.WebSocketProtocol := ARequestInfo.RawHeaders.Values['sec-websocket-protocol'];
|
|
context.WebSocketExtensions := ARequestInfo.RawHeaders.Values['sec-websocket-extensions'];
|
|
|
|
//Response
|
|
(* HTTP/1.1 101 Switching Protocols
|
|
Upgrade: websocket
|
|
Connection: Upgrade
|
|
Sec-WebSocket-Accept: s3pPLMBiTxaQ9kYGzzhZRbK+xOo= *)
|
|
AResponseInfo.ResponseNo := 101;
|
|
AResponseInfo.ResponseText := 'Switching Protocols';
|
|
AResponseInfo.CloseConnection := False;
|
|
//Connection: Upgrade
|
|
AResponseInfo.Connection := 'Upgrade';
|
|
//Upgrade: websocket
|
|
AResponseInfo.CustomHeaders.Values['Upgrade'] := 'websocket';
|
|
|
|
//Sec-WebSocket-Accept: s3pPLMBiTxaQ9kYGzzhZRbK+xOo=
|
|
sValue := Trim(context.WebSocketKey) + //... "minus any leading and trailing whitespace"
|
|
'258EAFA5-E914-47DA-95CA-C5AB0DC85B11'; //special GUID
|
|
hash := TIdHashSHA1.Create;
|
|
try
|
|
sValue := TIdEncoderMIME.EncodeBytes( //Base64
|
|
hash.HashString(sValue) ); //SHA1
|
|
finally
|
|
hash.Free;
|
|
end;
|
|
AResponseInfo.CustomHeaders.Values['Sec-WebSocket-Accept'] := sValue;
|
|
|
|
//send same protocol back?
|
|
AResponseInfo.CustomHeaders.Values['Sec-WebSocket-Protocol'] := context.WebSocketProtocol;
|
|
//we do not support extensions yet (gzip deflate compression etc)
|
|
//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
|
|
//but is could be done using idZlib.pas and DecompressGZipStream etc
|
|
|
|
//send response back
|
|
context.IOHandler.InputBuffer.Clear;
|
|
context.IOHandler.BusyUpgrading := True;
|
|
AResponseInfo.WriteHeader;
|
|
|
|
//handle all WS communication in seperate loop
|
|
DoWSExecute(AThread, (context.SocketIO as TIdServerSocketIOHandling_Ext) );
|
|
end;
|
|
end;
|
|
|
|
end.
|