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

write timeout + error handling (try except for callbacks)

Browse source
This commit is contained in:
André Mussche 2014-07-03 11:39:18 +02:00
parent a1b813b767
commit f79c3cdb8a
4 changed files with 65 additions and 17 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
IdHTTPWebsocketClient.pas
View file

@ -38,10 +38,12 @@ type
FOnData: TWebsocketMsgBin;
FOnTextData: TWebsocketMsgText;
FNoAsyncRead: Boolean;
FWriteTimeout: Integer;
function GetIOHandlerWS: TIdIOHandlerWebsocket;
procedure SetIOHandlerWS(const Value: TIdIOHandlerWebsocket);
procedure SetOnData(const Value: TWebsocketMsgBin);
procedure SetOnTextData(const Value: TWebsocketMsgText);
procedure SetWriteTimeout(const Value: Integer);
protected
FSocketIOCompatible: Boolean;
FSocketIOHandshakeResponse: string;
@ -94,6 +96,8 @@ type
property Host;
property Port;
property WSResourceName: string read FWSResourceName write FWSResourceName;
property WriteTimeout: Integer read FWriteTimeout write SetWriteTimeout default 2000;
end;
// on error
@ -231,6 +235,8 @@ begin
// FHeartBeat := TTimer.Create(nil);
// FHeartBeat.Enabled := False;
// FHeartBeat.OnTimer := HeartBeatTimer;
FWriteTimeout := 2 * 1000;
end;
procedure TIdHTTPWebsocketClient.AsyncDispatchEvent(const aEvent: TStream);
@ -752,6 +758,11 @@ begin
if not Self.NoAsyncRead then
TIdWebsocketMultiReadThread.Instance.AddClient(Self);
end;
//default 2s write timeout
//http://msdn.microsoft.com/en-us/library/windows/desktop/ms740532(v=vs.85).aspx
if Connected then
Self.IOHandler.Binding.SetSockOpt(SOL_SOCKET, SO_SNDTIMEO, Self.WriteTimeout);
end;
procedure TIdHTTPWebsocketClient.Lock;
@ -899,6 +910,13 @@ begin
// TIdWebsocketMultiReadThread.Instance.AddClient(Self);
end;
procedure TIdHTTPWebsocketClient.SetWriteTimeout(const Value: Integer);
begin
FWriteTimeout := Value;
if Connected then
Self.IOHandler.Binding.SetSockOpt(SOL_SOCKET, SO_SNDTIMEO, Self.WriteTimeout);
end;
{ TIdHTTPSocketIOClient }
(*

40
IdServerSocketIOHandling.pas
View file

@ -88,28 +88,36 @@ begin
begin
if context.IsDisconnected then Continue;
if not Assigned(aCallback) then
WriteSocketIOEvent(context, ''{no room}, aEventName, jsonarray, nil, nil)
else
WriteSocketIOEventRef(context, ''{no room}, aEventName, jsonarray,
procedure(const aData: string)
begin
aCallback(context, SO(aData), nil);
end, aOnError);
try
if not Assigned(aCallback) then
WriteSocketIOEvent(context, ''{no room}, aEventName, jsonarray, nil, nil)
else
WriteSocketIOEventRef(context, ''{no room}, aEventName, jsonarray,
procedure(const aData: string)
begin
aCallback(context, SO(aData), nil);
end, aOnError);
except
//try to send to others
end;
Inc(Result);
end;
for context in FConnectionsGUID.Values do
begin
if context.IsDisconnected then Continue;
if not Assigned(aCallback) then
WriteSocketIOEvent(context, ''{no room}, aEventName, jsonarray, nil, nil)
else
WriteSocketIOEventRef(context, ''{no room}, aEventName, jsonarray,
procedure(const aData: string)
begin
aCallback(context, SO(aData), nil);
end, aOnError);
try
if not Assigned(aCallback) then
WriteSocketIOEvent(context, ''{no room}, aEventName, jsonarray, nil, nil)
else
WriteSocketIOEventRef(context, ''{no room}, aEventName, jsonarray,
procedure(const aData: string)
begin
aCallback(context, SO(aData), nil);
end, aOnError);
except
//try to send to others
end;
Inc(Result);
end;
finally

7
IdSocketIOHandling.pas
View file

@ -601,6 +601,8 @@ procedure TIdBaseSocketIOHandling.ProcessSocketIORequest(
begin
Result := '';
ilength := strmRequest.Size - strmRequest.Position;
if ilength <= 0 then
Exit;
SetLength(utf8, ilength);
strmRequest.Read(utf8[0], ilength);
Result := TEncoding.UTF8.GetString(utf8);
@ -1365,6 +1367,11 @@ begin
FEvent := TEvent.Create;
FQueue.Add(aData);
//max 1000 items in queue (otherwise infinite mem leak possible?)
while FQueue.Count > 1000 do
FQueue.Delete(0);
FEvent.SetEvent;
end;

17
IdWebsocketServer.pas
View file

@ -15,7 +15,9 @@ type
FSocketIO: TIdServerSocketIOHandling_Ext;
FOnMessageText: TWebsocketMessageText;
FOnMessageBin: TWebsocketMessageBin;
FWriteTimeout: Integer;
function GetSocketIO: TIdServerSocketIOHandling;
procedure SetWriteTimeout(const Value: Integer);
protected
procedure DoCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo;
AResponseInfo: TIdHTTPResponseInfo); override;
@ -34,12 +36,14 @@ type
property OnMessageBin : TWebsocketMessageBin read FOnMessageBin write FOnMessageBin;
property SocketIO: TIdServerSocketIOHandling read GetSocketIO;
published
property WriteTimeout: Integer read FWriteTimeout write SetWriteTimeout default 2000;
end;
implementation
uses
IdServerIOHandlerWebsocket, IdStreamVCL, IdGlobal, Windows;
IdServerIOHandlerWebsocket, IdStreamVCL, IdGlobal, Windows, IdWinsock2;
{ TIdWebsocketServer }
@ -52,12 +56,18 @@ begin
ContextClass := TIdServerWSContext;
if IOHandler = nil then
IOHandler := TIdServerIOHandlerWebsocket.Create(Self);
FWriteTimeout := 2 * 1000; //2s
end;
procedure TIdWebsocketServer.ContextCreated(AContext: TIdContext);
begin
inherited ContextCreated(AContext);
(AContext as TIdServerWSContext).OnCustomChannelExecute := Self.WebsocketChannelRequest;
//default 2s write timeout
//http://msdn.microsoft.com/en-us/library/windows/desktop/ms740532(v=vs.85).aspx
AContext.Connection.Socket.Binding.SetSockOpt(SOL_SOCKET, SO_SNDTIMEO, Self.WriteTimeout);
end;
procedure TIdWebsocketServer.ContextDisconnected(AContext: TIdContext);
@ -109,6 +119,11 @@ begin
end;
end;
procedure TIdWebsocketServer.SetWriteTimeout(const Value: Integer);
begin
FWriteTimeout := Value;
end;
procedure TIdWebsocketServer.WebsocketChannelRequest(
const AContext: TIdServerWSContext; aType: TWSDataType; const aStrmRequest,
aStrmResponse: TMemoryStream);