mORMot Open Source

Daniel

Member

Registered: 2016-12-08

Posts: 23

Getting 404 errors with higher traffic

For months now in live deployment we had reports of 404 errors that we could not reproduce.
I made a small test app, to try reproduce the problem.
It contains a websocket server and client. It has timer with adjustable interval. When timer fires message is sent to server which sends it back to all connected clients.
When client receives the message it adds the latency to memo.
Message contains a timestamp and receiving client calculates difference from timestamp to now, thus latency.

When testing I quickly saw that reducing the interval under 40 ms causes 404 exceptions. This is with single instance - one server and one client in same exe.

Second problem is with several clients, if I run about 4 clients and set interval to 100 ms, after a while again 404 exception happens.

I wonder if you can help me understand what is the problem, as this seems to reproduce the errors we have in live environment.

I include the source for this project:

DFM:

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 305
  ClientWidth = 393
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object bServer: TSpeedButton
    Left = 7
    Top = 8
    Width = 60
    Height = 26
    AllowAllUp = True
    GroupIndex = 1
    Caption = 'Server'
    OnClick = Button1Click
  end
  object bClient: TSpeedButton
    Left = 73
    Top = 8
    Width = 60
    Height = 26
    AllowAllUp = True
    GroupIndex = 2
    Caption = 'Client'
    OnClick = Button2Click
  end
  object Memo1: TMemo
    Left = 8
    Top = 74
    Width = 185
    Height = 215
    ReadOnly = True
    TabOrder = 0
  end
  object eHost: TEdit
    Left = 8
    Top = 47
    Width = 130
    Height = 21
    TabOrder = 1
    Text = 'localhost'
  end
  object Memo2: TMemo
    Left = 199
    Top = 74
    Width = 185
    Height = 215
    ReadOnly = True
    TabOrder = 2
  end
  object ePort: TEdit
    Left = 144
    Top = 47
    Width = 38
    Height = 21
    TabOrder = 3
    Text = '9000'
  end
  object eInterval: TLabeledEdit
    Left = 327
    Top = 47
    Width = 57
    Height = 21
    EditLabel.Width = 38
    EditLabel.Height = 13
    EditLabel.Caption = 'Interval'
    TabOrder = 4
    Text = '100'
  end
  object Timer1: TTimer
    Enabled = False
    Interval = 100
    OnTimer = Timer1Timer
    Left = 264
    Top = 40
  end
end

PAS

unit frmMain;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.Buttons,

  SynCommons,
  mORMot,
  mORMotHttpClient,
  mORMotHttpServer,
  SynBidirSock;

type
  TOSSServer = class;
  TOSSMessage = class;
  TOssCallback = class;

  IOSSMessage = interface(IInvokable)
  ['{4F30D230-AA46-4013-A900-33A7B79DD175}']
    function GetTimeStamp: TDateTimeMS;
    procedure SetTimeStamp(const Value: TDateTimeMS);
    property TimeStamp: TDateTimeMS read GetTimeStamp write SetTimeStamp;
  end;

  TOSSMessage = class(TPersistent)
  private
    fTimeStamp: TDateTimeMS;
    function GetTimeStamp: TDateTimeMS;
    procedure SetTimeStamp(const Value: TDateTimeMS);
  published
    property TimeStamp: TDateTimeMS read GetTimeStamp write SetTimeStamp;
  end;

  IOSSCallback = interface(IInvokable)
    ['{C561AB6F-61E0-4009-A1A0-26630A6A6D1F}']
    procedure ReceiveOssMessage(const AOSSMessage: TOSSMessage);
  end;

  IOSSService = interface(IInvokable)
    ['{DDB2805E-3521-4784-928B-95CE0B9FB4DD}']
    procedure SendOssMessage(const AOSSMessage: TOSSMessage);
    procedure SubscribeToOss(const ACallback: IOSSCallback);
  end;

  TForm1 = class(TForm)
    Memo1: TMemo;
    eHost: TEdit;
    Memo2: TMemo;
    bServer: TSpeedButton;
    bClient: TSpeedButton;
    ePort: TEdit;
    eInterval: TLabeledEdit;
    Timer1: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    fHttpServer: TSQLHttpServer;
    fWebSocketServerRest: TWebSocketServerRest;
    fServer: TSQLRestServerFullMemory;
    fClient: TSQLHttpClientWebsockets;
    fService: IOSSService;
    fCallback: IOSSCallback;
  public
    procedure BeforeDestruction; override;
    property HttpServer: TSQLHttpServer read fHttpServer;
    property WebSocketServerRest: TWebSocketServerRest read fWebSocketServerRest;
    property Server: TSQLRestServerFullMemory read fServer;
  end;

  TOSSServer = class(TInterfacedObject, IOSSService)
  private
    fClients: TInterfaceList;
  protected
    procedure SendOssMessage(const AOSSMessage: TOSSMessage);
    procedure SubscribeToOss(const ACallback: IOSSCallback);
  public
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
    procedure ServiceStart();
  published
  end;

  TOssCallback = class(TInterfacedCallback,IOSSCallback)
  private
  protected
    procedure ReceiveOssMessage(const AOSSMessage: TOSSMessage);
  end;

var
  Form1: TForm1;
  Lock: TRTLCriticalSection;

implementation

{$R *.dfm}

uses
  System.DateUtils;

const
  TRANSMISSION_KEY = 'OSS_WebSockets';

procedure TForm1.BeforeDestruction;
begin
  inherited;
  fService := nil;
  fCallback := nil;
  FreeAndNil(fHttpServer);
  FreeAndNil(fServer);
  FreeAndNil(fClient);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Port: string;
begin
  if not bServer.Down then
  begin
    FreeAndNil(fHttpServer);
    FreeAndNil(fServer);
    exit;
  end;
  fServer := TSQLRestServerFullMemory.CreateWithOwnModel([]);
  Server.ServiceDefine(TOSSServer,[IOSSService],sicShared).ByPassAuthentication := true;
  Server.CreateMissingTables;
  fHttpServer := TSQLHttpServer.Create(ePort.text, [Server], '+', useBidirSocket, 32, secSynShaAes, 'OSS');
  fWebSocketServerRest := HttpServer.WebSocketsEnable(Server, TRANSMISSION_KEY, True);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  s: string;
begin
  if not bClient.Down then
  begin
    Timer1.Enabled := false;
    fService := nil;
    fCallback := nil;
    FreeAndNil(fClient);
    exit;
  end;
  fClient := TSQLHttpClientWebsockets.Create(eHost.Text, ePort.Text, TSQLModel.Create([]));
  fClient.Model.Owner := fClient;
  s := fClient.WebSocketsUpgrade(TRANSMISSION_KEY);
  if s <> '' then
    raise Exception.Create(s);
  if not fClient.ServerTimeStampSynchronize then
    raise Exception.CreateFmt(fClient.LastErrorMessage+
      '. Error connecting to OSS server at %s:%d', [fClient.HostName, fClient.Port]);
  fClient.ServiceDefine([IOSSService],sicShared);
  if not fClient.Services.Resolve(IOSSService, fService) then
    raise Exception.Create('Service IOSSService unavailable');
  fCallback := TOssCallback.Create(fClient, IOssCallback);
  fService.SubscribeToOss(fCallback);
  Timer1.Enabled := true;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  vMessage: TOSSMessage;
begin
  vMessage := TOSSMessage.Create;
  try
    vMessage.TimeStamp := now;
    Timer1.Interval := StrToIntDef(eInterval.Text, Timer1.Interval);
    try
      fService.SendOssMessage(vMessage);
    except
      on e: exception do
      begin
        Timer1.Enabled := false;
        Form1.Memo2.Lines.Add(e.Message);
        raise;
      end;
    end;
  finally
    vMessage.Free;
  end;
end;

{ TOSSServer }

procedure TOSSServer.AfterConstruction;
begin
  inherited;
  ServiceStart;
end;

procedure TOSSServer.BeforeDestruction;
begin
  inherited;
  fClients.Free;
end;

procedure TOSSServer.SendOssMessage(const AOSSMessage: TOSSMessage);
var
  i: integer;
begin
  for I := 0 to fClients.Count - 1 do
  try
    (fClients[i] as IOSSCallback).ReceiveOssMessage(AOSSMessage);
  except

  end;
end;

procedure TOSSServer.ServiceStart;
begin
  fClients := TInterfaceList.Create;
end;

procedure TOSSServer.SubscribeToOss(const ACallback: IOSSCallback);
begin
  fClients.Add(ACallBack);
end;

{ TOssCallback }

procedure TOssCallback.ReceiveOssMessage(const AOSSMessage: TOSSMessage);
var
  LatencyMS: integer;
begin
  EnterCriticalSection(Lock);
  try
    LatencyMS := MilliSecondsBetween(now, AOSSMessage.TimeStamp);
    Form1.Memo2.Lines.Add(IntToStr(LatencyMS));
  finally
    LeaveCriticalSection(Lock);
  end;
end;

{ TOSSMessage }

function TOSSMessage.GetTimeStamp: TDateTimeMS;
begin
  result := fTimeStamp;
end;

procedure TOSSMessage.SetTimeStamp(const Value: TDateTimeMS);
begin
  fTimeStamp := Value;
end;

initialization
  TInterfaceFactory.RegisterInterfaces([
    TypeInfo(IOSSMessage),
    TypeInfo(IOSSService),
    TypeInfo(IOSSCallback)]);
  InitializeCriticalSection(Lock);

finalization
  DeleteCriticalSection(Lock);
end.

pvn0

Member

From: Slovenia

Registered: 2018-02-12

Posts: 211

Re: Getting 404 errors with higher traffic

I wonder if you can help me understand what is the problem

Sure!
Not understanding how to write thread safe code,
not reading documentation,
not reading websocket example,

and also not reading forum rules

But in all seriousness, check the websocket examples under Sqlite3/Samples/31-Websockets and try to base your test project on that.

ab

Administrator

From: France

Registered: 2010-06-21

Posts: 14,661

Website

Re: Getting 404 errors with higher traffic

In our regression tests, TTestMultiThreadProcess.Websockets do validate the multi-thread client access of such a server.
In production, we have such servers running since years.
So I guess there is something wrong.

I have enhanced
https://synopse.info/forum/misc.php?action=rules
trying to make it even clearer...
And put a link to https://stackoverflow.com/help/minimal- … le-example

There is a minimal reproducible example here. Great!
But a link to a .zip instead of inlining everything to the forum would have been even better.

First advice is to enable the logs, in verbose mode, and see what's happening in your code.
Even putting every clients and servers in a single console app, so that it would be easier to check the logs requests/answers logic.
Without any UI, which tend to mess with threads.
Also don't run the apps in the Delphi IDE debugger, which tends to reduce the thread responsiveness of the application - run it stand alone.