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

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,13 +143,13 @@ 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;
+  TInterlocked.Exchange(FStarted, 0);
+  if Assigned(FServer) then
     FServer.Active := False;
 end;
 
@@ -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.CADUpdate then
-    Exit;
+      if not FDb.StartUpdateListener then
+        Continue;
+
+      if not FDb.ConsumeCADUpdate then
+        Continue;
 
-  FDb.CADUpdate := False;
       BroadcastAll;
+    end;
+  except
+    on E: Exception do
+      Logger.Log(1, 'WsDataModel worker stopped: ' + E.Message);
+  end;
+end;
+
+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
+  "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,6 +825,7 @@ begin
 
   FHeartbeatOutstanding := False;
   CancelHeartbeatTimeout;
+  if FHeartbeatTimerId = 0 then
     ScheduleHeartbeat(HEARTBEAT_INTERVAL_MS);
 end;