Skip to content

E
emiMobile
Commit c34c8c72 by Mac Stephens
Options

Prevent WebSocket update lockups, recover DB listeners, and move log levels to INI

parent 9cdc7cfd
Showing with 183 additions and 60 deletions
emiMobileServer/Source/Api.Database.dfm
......@@ -1363,6 +1363,7 @@ object ApiDatabaseModule: TApiDatabaseModule
Connection = ucENTCAD
Events = 'disupdate'
OnEvent = UniAlerter1Event
OnError = UniAlerter1Error
Left = 324
Top = 382
end
......
emiMobileServer/Source/Api.Database.pas
......@@ -6,6 +6,7 @@ uses
System.SysUtils, System.Classes, Data.DB, MemDS, DBAccess, Uni, UniProvider,
PostgreSQLUniProvider, System.Variants, System.Generics.Collections, System.IniFiles,
Common.Logging, Vcl.Forms, System.Character, Common.Ini, DAAlerter,
System.SyncObjs,
UniAlerter;
type
......@@ -210,14 +211,17 @@ type
procedure DataModuleCreate(Sender: TObject);
procedure UniAlerter1Event(Sender: TDAAlerter; const EventName,
Message: string);
procedure UniAlerter1Error(Sender: TDAAlerter; E: Exception);
private
{ Private declarations }
FCADUpdate: Integer;
FUpdateListenerFailed: Integer;
public
CADUpdate: Boolean;
function HandleUniqueFilenames(const category: string): string;
function BadgeCounts(const BaseQuery: TUniQuery): Integer;
function EnsureConnected: Boolean;
function StartUpdateListener: Boolean;
procedure MarkCADUpdate;
function ConsumeCADUpdate: Boolean;
end;
var
......@@ -232,7 +236,8 @@ implementation
procedure TApiDatabaseModule.DataModuleCreate(Sender: TObject);
begin
CADUpdate := False;
FCADUpdate := 0;
FUpdateListenerFailed := 0;
ucENTCAD.ProviderName := 'PostgreSQL';
ucENTCAD.Server := IniEntries.DatabaseServer;
......@@ -241,8 +246,6 @@ begin
ucENTCAD.Username := IniEntries.DatabaseUsername;
ucENTCAD.Password := IniEntries.DatabasePassword;
ucENTCAD.LoginPrompt := False;
EnsureConnected;
end;
......@@ -258,21 +261,64 @@ begin
ucENTCAD.ExecSQL('set search_path to lems, avl, entcad, public');
Logger.Log(2, 'PostgreSQL API search_path set to lems, avl, entcad, public');
end;
Result := True;
except
on E: Exception do
Logger.Log(1, 'PostgreSQL API database unavailable: ' + E.Message);
end;
end;
function TApiDatabaseModule.StartUpdateListener: Boolean;
begin
Result := False;
if TInterlocked.Exchange(FUpdateListenerFailed, 0) <> 0 then
begin
try
if UniAlerter1.Active then
UniAlerter1.Stop;
ucENTCAD.Disconnect;
except
on E: Exception do
begin
Logger.Log(1, 'PostgreSQL disupdate listener reset failed: ' + E.Message);
TInterlocked.Exchange(FUpdateListenerFailed, 1);
Exit;
end;
end;
end;
if not EnsureConnected then
Exit;
try
if not UniAlerter1.Active then
begin
Logger.Log(1, 'Starting PostgreSQL disupdate listener');
UniAlerter1.Start;
Logger.Log(1, 'PostgreSQL disupdate listener started');
CADUpdate := True;
MarkCADUpdate;
end;
Result := True;
except
on E: Exception do
Logger.Log(1, 'PostgreSQL API database unavailable: ' + E.Message);
Logger.Log(1, 'PostgreSQL disupdate listener unavailable: ' + E.Message);
end;
end;
procedure TApiDatabaseModule.MarkCADUpdate;
begin
TInterlocked.Exchange(FCADUpdate, 1);
end;
function TApiDatabaseModule.ConsumeCADUpdate: Boolean;
begin
Result := TInterlocked.Exchange(FCADUpdate, 0) <> 0;
end;
procedure TApiDatabaseModule.uqComplaintListCalcFields(DataSet: TDataSet);
var
raw: string;
......@@ -343,7 +389,14 @@ end;
procedure TApiDatabaseModule.UniAlerter1Event(Sender: TDAAlerter; const EventName, Message: string);
begin
if SameText(EventName, 'disupdate') then
CADUpdate := True;
MarkCADUpdate;
end;
procedure TApiDatabaseModule.UniAlerter1Error(Sender: TDAAlerter; E: Exception);
begin
Logger.Log(1, 'PostgreSQL disupdate listener error: ' + E.Message);
TInterlocked.Exchange(FUpdateListenerFailed, 1);
MarkCADUpdate;
end;
function TApiDatabaseModule.BadgeCounts(const BaseQuery: TUniQuery): Integer;
......
emiMobileServer/Source/Api.ServiceImpl.pas
......@@ -47,7 +47,7 @@ begin
ApiDB := TApiDatabaseModule.Create(nil);
if not ApiDB.ucENTCAD.Connected then
if not ApiDB.EnsureConnected then
begin
Logger.Log(1, 'Unable to connect to API database');
raise EXDataHttpException.Create(
......
emiMobileServer/Source/Common.Config.pas
......@@ -13,8 +13,6 @@ type
FAdminPassword: string;
FWebAppFolder: string;
FReportsFolder: string;
FMemoLogLevel: Integer;
FFileLogLevel: Integer;
FAuditEnabled: Boolean;
public
constructor Create;
......@@ -24,8 +22,6 @@ type
property webAppFolder: string read FWebAppFolder write FWebAppFolder;
property reportsFolder: string read FReportsFolder write FReportsFolder;
property auditEnabled: Boolean read FAuditEnabled write FAuditEnabled;
property memoLogLevel: Integer read FMemoLogLevel write FMemoLogLevel;
property fileLogLevel: Integer read FFileLogLevel write FFileLogLevel;
end;
procedure LoadServerConfig;
......@@ -64,8 +60,6 @@ begin
Logger.Log(1, '-- adminPassword: ' + serverConfig.adminPassword + IfThen(serverConfig.adminPassword = 'whatisthisusedfor', ' [default]', ' [from config]'));
Logger.Log(1, '-- jwtTokenSecret: ' + serverConfig.jwtTokenSecret + IfThen(serverConfig.jwtTokenSecret = 'super_secret0123super_secret4567', ' [default]', ' [from config]'));
Logger.Log(1, '-- webAppFolder: ' + serverConfig.webAppFolder + IfThen(serverConfig.webAppFolder = 'static', ' [default]', ' [from config]'));
Logger.Log(1, '-- memoLogLevel: ' + IntToStr(serverConfig.memoLogLevel));
Logger.Log(1, '-- fileLogLevel: ' + IntToStr(serverConfig.fileLogLevel));
Logger.Log(1, '-- auditEnabled: ' + BoolToStr(serverConfig.auditEnabled, True));
end
else
......@@ -87,8 +81,6 @@ begin
jwtTokenSecret := 'super_secret0123super_secret4567';
webAppFolder := 'static';
reportsFolder := 'reports';
memoLogLevel := 3;
fileLogLevel := 4;
auditEnabled := False;
Logger.Log(1, '--TServerConfig.Create - end');
end;
......
emiMobileServer/Source/WebSocket.Manager.pas
......@@ -7,7 +7,7 @@ uses
System.SysUtils,
System.JSON,
System.Generics.Collections,
Vcl.ExtCtrls,
System.SyncObjs,
VCL.TMSFNCWebSocketServer,
VCL.TMSFNCWebSocketCommon;
......@@ -54,13 +54,15 @@ type
FClients: TObjectList<TConnectedClient>;
FClientsLock: TObject;
FSendLock: TObject;
FHeartbeatTimer: TTimer;
FHeartbeatThread: TThread;
FHeartbeatStopEvent: TEvent;
FStarted: Integer;
FOnClientsChanged: TClientsChangedEvent;
function TrySendTextToClient(const AConnectionId, AMessage: string;
ALogFailure: Boolean = True): Boolean;
function TryCloseClient(const AConnectionId: string): Boolean;
procedure HeartbeatTimer(Sender: TObject);
procedure HeartbeatSweep;
procedure NotifyClientsChanged;
procedure HandshakeResponseSent(Sender: TObject; AConnection: TTMSFNCWebSocketServerConnection);
procedure MessageReceived(Sender: TObject; AConnection: TTMSFNCWebSocketConnection; const AMessage: string);
......@@ -104,17 +106,32 @@ begin
FServer.OnMessageReceived := MessageReceived;
FServer.OnDisconnect := ClientDisconnected;
FHeartbeatTimer := TTimer.Create(nil);
FHeartbeatTimer.Enabled := False;
FHeartbeatTimer.Interval := HEARTBEAT_SWEEP_INTERVAL_MS;
FHeartbeatTimer.OnTimer := HeartbeatTimer;
FStarted := 0;
FHeartbeatStopEvent := TEvent.Create(nil, False, False, '');
FHeartbeatThread := TThread.CreateAnonymousThread(
procedure
begin
while not TThread.CurrentThread.CheckTerminated do
begin
if FHeartbeatStopEvent.WaitFor(HEARTBEAT_SWEEP_INTERVAL_MS) = wrSignaled then
Break;
if TInterlocked.CompareExchange(FStarted, 0, 0) <> 0 then
HeartbeatSweep;
end;
end);
FHeartbeatThread.FreeOnTerminate := False;
FHeartbeatThread.Start;
end;
destructor TWebSocketManager.Destroy;
begin
FHeartbeatTimer.Enabled := False;
Stop;
FHeartbeatTimer.Free;
FHeartbeatThread.Terminate;
FHeartbeatStopEvent.SetEvent;
FHeartbeatThread.WaitFor;
FHeartbeatThread.Free;
FHeartbeatStopEvent.Free;
FServer.Free;
FClients.Free;
FSendLock.Free;
......@@ -126,14 +143,14 @@ end;
procedure TWebSocketManager.Start;
begin
FServer.Active := True;
FHeartbeatTimer.Enabled := True;
TInterlocked.Exchange(FStarted, 1);
end;
procedure TWebSocketManager.Stop;
begin
if Assigned(FHeartbeatTimer) then
FHeartbeatTimer.Enabled := False;
FServer.Active := False;
TInterlocked.Exchange(FStarted, 0);
if Assigned(FServer) then
FServer.Active := False;
end;
function TWebSocketManager.TrySendTextToClient(const AConnectionId,
......@@ -141,9 +158,11 @@ function TWebSocketManager.TrySendTextToClient(const AConnectionId,
var
client: TConnectedClient;
connection: TTMSFNCWebSocketServerConnection;
sendFailed: Boolean;
begin
Result := False;
connection := nil;
sendFailed := False;
// TMS owns and frees the connection immediately after its disconnect
// callback returns. Holding FSendLock makes that callback wait until the
......@@ -174,13 +193,35 @@ begin
except
on E: Exception do
begin
sendFailed := True;
if ALogFailure then
Logger.Log(2, 'WebSocket send failed: ' + E.Message);
Logger.Log(2, 'WebSocket send failed for ' + AConnectionId + ': ' + E.Message);
end;
end;
if sendFailed then
begin
TMonitor.Enter(FClientsLock);
try
for client in FClients do
if SameText(client.ConnectionId, AConnectionId) then
begin
client.Closing := True;
Break;
end;
finally
TMonitor.Exit(FClientsLock);
end;
end;
finally
TMonitor.Exit(FSendLock);
end;
if sendFailed then
begin
NotifyClientsChanged;
TryCloseClient(AConnectionId);
end;
end;
function TWebSocketManager.TryCloseClient(
......@@ -224,7 +265,7 @@ begin
end;
end;
procedure TWebSocketManager.HeartbeatTimer(Sender: TObject);
procedure TWebSocketManager.HeartbeatSweep;
var
staleConnectionIds: TList<string>;
client: TConnectedClient;
......
emiMobileServer/Source/Ws.DataModel.pas
unit Ws.DataModel;
// Server-side WebSocket data model.
// Owns a VCL timer that fires every FIntervalMs milliseconds, queries the
// Owns a worker thread that checks every FIntervalMs milliseconds, queries the
// database for the five data sets used by the polling timers that existed in
// each connected browser client, and broadcasts the results to every
// handshaked WebSocket connection via the supplied broadcast callback.
......@@ -14,9 +14,8 @@ interface
uses
System.SysUtils, System.Classes, System.JSON,
System.Generics.Collections,
System.Generics.Collections, System.SyncObjs,
Data.DB,
Vcl.ExtCtrls,
Api.Database,
WsMessages,
Common.Logging;
......@@ -27,10 +26,13 @@ type
TWsDataModel = class
private
FDb: TApiDatabaseModule;
FTimer: TTimer;
FThread: TThread;
FStopEvent: TEvent;
FIntervalMs: Integer;
FBroadcast: TWsBroadcastProc;
procedure TimerFire(Sender: TObject);
procedure Execute;
procedure ConfigureQueryTimeouts;
procedure BroadcastAll;
function BuildBadgeCountsJson: string;
......@@ -54,31 +56,58 @@ constructor TWsDataModel.Create(ABroadcast: TWsBroadcastProc; AIntervalMs: Integ
begin
inherited Create;
FBroadcast := ABroadcast;
FIntervalMs := AIntervalMs;
FStopEvent := TEvent.Create(nil, False, False, '');
FDb := TApiDatabaseModule.Create(nil);
FTimer := TTimer.Create(nil);
FTimer.Interval := AIntervalMs;
FTimer.OnTimer := TimerFire;
FTimer.Enabled := True;
ConfigureQueryTimeouts;
FThread := TThread.CreateAnonymousThread(Execute);
FThread.FreeOnTerminate := False;
FThread.Start;
end;
destructor TWsDataModel.Destroy;
begin
FTimer.Enabled := False;
FTimer.Free;
FThread.Terminate;
FStopEvent.SetEvent;
FThread.WaitFor;
FThread.Free;
FDb.Free;
FStopEvent.Free;
inherited;
end;
procedure TWsDataModel.TimerFire(Sender: TObject);
procedure TWsDataModel.Execute;
begin
if not FDb.ucENTCAD.Connected then
Exit;
try
while not TThread.CurrentThread.CheckTerminated do
begin
if FStopEvent.WaitFor(FIntervalMs) = wrSignaled then
Break;
if not FDb.StartUpdateListener then
Continue;
if not FDb.ConsumeCADUpdate then
Continue;
if not FDb.CADUpdate then
Exit;
BroadcastAll;
end;
except
on E: Exception do
Logger.Log(1, 'WsDataModel worker stopped: ' + E.Message);
end;
end;
FDb.CADUpdate := False;
BroadcastAll;
procedure TWsDataModel.ConfigureQueryTimeouts;
const
COMMAND_TIMEOUT_SECONDS = 15;
begin
FDb.uqBadgeCounts.SpecificOptions.Values['CommandTimeout'] := IntToStr(COMMAND_TIMEOUT_SECONDS);
FDb.uqMapUnits.SpecificOptions.Values['CommandTimeout'] := IntToStr(COMMAND_TIMEOUT_SECONDS);
FDb.uqMapComplaintUnitsList.SpecificOptions.Values['CommandTimeout'] := IntToStr(COMMAND_TIMEOUT_SECONDS);
FDb.uqMapComplaints.SpecificOptions.Values['CommandTimeout'] := IntToStr(COMMAND_TIMEOUT_SECONDS);
FDb.uqUnitList.SpecificOptions.Values['CommandTimeout'] := IntToStr(COMMAND_TIMEOUT_SECONDS);
FDb.uqComplaintList.SpecificOptions.Values['CommandTimeout'] := IntToStr(COMMAND_TIMEOUT_SECONDS);
end;
procedure TWsDataModel.BroadcastAll;
......
emiMobileServer/bin/emiMobileServer.json
......@@ -2,7 +2,5 @@
"url": "http://localhost:2001/emsys/emiMobile/",
"jwtTokenSecret": "super_secret0123super_secret4567",
"adminPassword": "whatisthisusedfor?",
"webAppFolder": "static",
"memoLogLevel": 5,
"fileLogLevel": 5
}
\ No newline at end of file
"webAppFolder": "static"
}
emiMobileServer/emiMobileServer.dpr
......@@ -2,6 +2,7 @@ program emiMobileServer;
uses
FastMM4,
System.Classes,
System.SyncObjs,
System.SysUtils,
Vcl.StdCtrls,
......@@ -79,6 +80,9 @@ var
LogMsg: string;
begin
if logLevel > FLogLevel then
Exit;
FCriticalSection.Acquire;
try
LogTime := Now;
......@@ -90,11 +94,16 @@ begin
else
FormattedMessage := FormattedMessage + '[' + IntToStr(logLevel) +'] ' + LogMsg;
if logLevel <= FLogLevel then
FLogMemo.Lines.Add( FormattedMessage );
finally
FCriticalSection.Release;
end;
TThread.Queue(nil,
procedure
begin
if Assigned(FLogMemo) and not (csDestroying in FLogMemo.ComponentState) then
FLogMemo.Lines.Add(FormattedMessage);
end);
end;
{ TFileLogAppender }
......
webEMIMobile/Module.Websocket.pas
......@@ -825,7 +825,8 @@ begin
FHeartbeatOutstanding := False;
CancelHeartbeatTimeout;
ScheduleHeartbeat(HEARTBEAT_INTERVAL_MS);
if FHeartbeatTimerId = 0 then
ScheduleHeartbeat(HEARTBEAT_INTERVAL_MS);
end;
procedure TdmWebsocket.RegisterLifecycleListeners;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment