http time out & retry when interface-based service is used

DateClient.dpr

program DateClient;

{$I Synopse.inc} // define HASINLINE USETYPEINFO CPU32 CPU64 OWNNORMTOUPPER
{$IFOPT D+} {$DEFINE DEBUG} {$ENDIF}
{$ASSERTIONS ON}

uses
  {$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
  SysUtils, StrUtils, Classes,

  SynCommons, SynLog, SynCrtSock, mORMot, mORMotHttpClient,
  SynSQLite3Static, // link SQLite3 statically

  uShellInterfaceDef in 'uShellInterfaceDef.pas',

  SampleData in 'SampleData.pas';

var
  I: Integer;
  ExePath: string;
  ExeDir: string;
  ExeName: string;
  
  DateStr: string;
  LogName: string;
  
  Model: TSQLModel;
  RestClientHttp: TSQLHttpClient;

  Shell: IShell;    
  ShellCmd: string;
  ShellCmdStdOutput, ShellCmdStdError: TStringList;
  
begin

  ExePath := ParamStr(0);   
  ExeDir := ExtractFileDir(ExePath);
  ExeName := ExtractFileName(ExePath);

  DateStr := FormatDateTime('yyyy_mm_dd_hh_nn_ss_zzz', Now);
  LogName := Format('%s__%s', [ExeName, DateStr]);

  with TSynLog.Family do
  begin
    LocalTimeStamp := True;
    Level := LOG_VERBOSE;
    PerThreadLog := ptIdentifiedInOnFile;
    CustomFileName := LogName;
    DestinationPath := ExeDir;
    AutoFlushTimeOut := 5;
    RotateFileCount := 50;
    RotateFileSizeKB := 20 * 1024; // rotate by 20 MB logs
  end;

  Model := TSQLModel.Create([], ROOT_NAME);
  RestClientHttp := TSQLHttpClient.Create('127.0.0.1', PORT_NAME, Model, 
     False, '', '', HTTP_DEFAULT_SENDTIMEOUT, HTTP_DEFAULT_RECEIVETIMEOUT + 0 * 1000, HTTP_DEFAULT_CONNECTTIMEOUT);

  if RestClientHttp.ServerTimeStampSynchronize then begin
    if not RestClientHttp.Services.Resolve(IShell, Shell) then begin
      RestClientHttp.ServiceDefine([IShell], sicSingle);
    end;

    if RestClientHttp.Services['Shell'].Get(Shell) then begin
    	
      ShellCmd := Format(' date ; sleep 600 ', []);  
      
      ShellCmdStdOutput := TStringList.Create;
      ShellCmdStdError := TStringList.Create;

      Shell.Run(ShellCmd, ShellCmdStdOutput, ShellCmdStdError);

      for I := 0 to ShellCmdStdOutput.Count-1 do begin
        Writeln('DateClient', ShellCmdStdOutput[I]);
      end;

      for I := 0 to ShellCmdStdError.Count-1 do begin
        Writeln(System.ErrOutput, 'DateClient', ShellCmdStdError[I]);
      end;

      ShellCmdStdOutput.Free;
      ShellCmdStdError.Free;
    end;
     
  end;

  RestClientHttp.Free;
  Model.Free;
end.

DateClient.lpi

<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
  <ProjectOptions>
    <Version Value="11"/>
    <General>
      <Flags>
        <MainUnitHasCreateFormStatements Value="False"/>
        <MainUnitHasScaledStatement Value="False"/>
      </Flags>
      <SessionStorage Value="InProjectDir"/>
      <MainUnit Value="0"/>
      <Title Value="My Application"/>
      <UseAppBundle Value="False"/>
      <ResourceType Value="res"/>
    </General>
    <BuildModes Count="3">
      <Item1 Name="Default" Default="True"/>
      <Item2 Name="Debug">
        <CompilerOptions>
          <Version Value="11"/>
          <Target>
            <Filename Value="Build/linux_x86_64_fpc_release/DateClient"/>
          </Target>
          <SearchPaths>
            <IncludeFiles Value="$(ProjOutDir);../../../vendors/mORMot/;../../../vendors/mORMot/SQLite3/;"/>
            <OtherUnitFiles Value="../../../vendors/mORMot/;../../../vendors/mORMot/SQLite3/;"/>
            <UnitOutputDirectory Value="Build/linux_x86_64_fpc_release/units/"/>
          </SearchPaths>
          <Parsing>
            <SyntaxOptions>
              <IncludeAssertionCode Value="True"/>
            </SyntaxOptions>
          </Parsing>
          <CodeGeneration>
            <Checks>
              <IOChecks Value="True"/>
              <RangeChecks Value="True"/>
              <OverflowChecks Value="True"/>
              <StackChecks Value="True"/>
            </Checks>
            <VerifyObjMethodCallValidity Value="True"/>
            <TargetCPU Value="x86_64"/>
            <TargetOS Value="linux"/>
          </CodeGeneration>
          <Linking>
            <Debugging>
              <DebugInfoType Value="dsDwarf2Set"/>
              <UseHeaptrc Value="True"/>
              <TrashVariables Value="True"/>
              <UseExternalDbgSyms Value="True"/>
            </Debugging>
          </Linking>
        </CompilerOptions>
      </Item2>
      <Item3 Name="Release">
        <CompilerOptions>
          <Version Value="11"/>
          <Target>
            <Filename Value="Build/linux_x86_64_fpc_release/DateClient"/>
          </Target>
          <SearchPaths>
            <IncludeFiles Value="$(ProjOutDir);../../../vendors/mORMot/;../../../vendors/mORMot/SQLite3/;"/>
            <OtherUnitFiles Value="../../../vendors/mORMot/;../../../vendors/mORMot/SQLite3/;"/>
            <UnitOutputDirectory Value="Build/linux_x86_64_fpc_release/units/"/>
          </SearchPaths>
          <CodeGeneration>
            <SmartLinkUnit Value="True"/>
            <TargetCPU Value="x86_64"/>
            <TargetOS Value="linux"/>
            <Optimizations>
              <OptimizationLevel Value="3"/>
            </Optimizations>
          </CodeGeneration>
          <Linking>
            <Debugging>
              <GenerateDebugInfo Value="False"/>
            </Debugging>
            <LinkSmart Value="True"/>
          </Linking>
        </CompilerOptions>
      </Item3>      
    </BuildModes>
    <PublishOptions>
      <Version Value="2"/>
    </PublishOptions>
    <RunParams>
      <FormatVersion Value="2"/>
      <Modes Count="0"/>
    </RunParams>
    <Units Count="1">
      <Unit0>
        <Filename Value="DateClient.dpr"/>
        <IsPartOfProject Value="True"/>
      </Unit0>
    </Units>
    <RequiredPackages Count="1">
      <Item1>
        <PackageName Value="LCL"/>
      </Item1>
    </RequiredPackages>    
  </ProjectOptions>
  <CompilerOptions>
    <Version Value="11"/>
    <Target>
      <Filename Value="Build/linux_x86_64_fpc_release/DateClient"/>
    </Target>
    <SearchPaths>
      <IncludeFiles Value="$(ProjOutDir);../../../vendors/mORMot/;../../../vendors/mORMot/SQLite3/;"/>
      <OtherUnitFiles Value="../../../vendors/mORMot/;../../../vendors/mORMot/SQLite3/;"/>
      <UnitOutputDirectory Value="Build/linux_x86_64_fpc_release/units/"/>
    </SearchPaths>
    <CodeGeneration>
      <TargetCPU Value="x86_64"/>
      <TargetOS Value="linux"/>
    </CodeGeneration>
  </CompilerOptions>
  <Debugging>
    <Exceptions Count="3">
      <Item1>
        <Name Value="EAbort"/>
      </Item1>
      <Item2>
        <Name Value="ECodetoolError"/>
      </Item2>
      <Item3>
        <Name Value="EFOpenError"/>
      </Item3>
    </Exceptions>
  </Debugging>
</CONFIG>

SampleData.pas

/// it's a good practice to put all data definition into a stand-alone unit
// - this unit will be shared between client and server
unit SampleData;

interface

uses
  SynCommons, mORMot;

type
{$M+}

  /// here we declare the class containing the data
  // - it just has to inherits from TSQLRecord, and the published
  // properties will be used for the ORM (and all SQL creation)
  // - the beginning of the class name must be 'TSQL' for proper table naming
  // in client/server environnment
  TSQLSampleRecord = class(TSQLRecord)
  private
    fQuestion: RawUTF8;
    fName: RawUTF8;
    fTime: TModTime;
  published
    property Time: TModTime read fTime write fTime;
    property Name: RawUTF8 read fName write fName;
    property Question: RawUTF8 read fQuestion write fQuestion;
  end;

implementation

end.

ShellServer.dpr

program ShellServer;

{$I Synopse.inc} // define HASINLINE USETYPEINFO CPU32 CPU64 OWNNORMTOUPPER
{$IFOPT D+} {$DEFINE DEBUG} {$ENDIF}
{$ASSERTIONS ON}
         
uses
  {$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
  SysUtils, StrUtils, Classes, SyncObjs,

  SynCommons, SynTable, SynLog, SynSQLite3, mORMot, mORMotSQLite3, mORMotHttpServer,
  SynSQLite3Static, // link SQLite3 statically

  uShellInterfaceDef in 'uShellInterfaceDef.pas',
  uShellInterfaceImpl in 'uShellInterfaceImpl.pas',

  SampleData in 'SampleData.pas';

var
  I: Integer;
  ExePath: string;
  ExeDir: string;
  ExeName: string;
  
  DateStr: string;
  LogName: string;
  DBFileName: string;

  Model: TSQLModel;
  RestServer: TSQLRestServerDB;
  HttpServer: TSQLHttpServer;
  
  SimpleEvent: TSimpleEvent;
begin

  ExePath := ParamStr(0);   
  ExeDir := ExtractFileDir(ExePath);
  ExeName := ExtractFileName(ExePath);

  DateStr := FormatDateTime('yyyy_mm_dd_hh_nn_ss_zzz', Now);
  LogName := Format('%s__%s', [ExeName, DateStr]);
  DBFileName := ExeDir + LogName + '.db3';

  with TSynLog.Family do
  begin
    LocalTimeStamp := True;
    Level := LOG_VERBOSE;
    PerThreadLog := ptIdentifiedInOnFile;
    CustomFileName := LogName;
    DestinationPath := ExeDir;
    AutoFlushTimeOut := 5;
    RotateFileCount := 50;
    RotateFileSizeKB := 20 * 1024; // rotate by 20 MB logs
  end;

  Model := TSQLModel.Create([], ROOT_NAME);

  RestServer := TSQLRestServerDB.Create(Model, DBFileName, FALSE);
  RestServer.DB.Synchronous := smFull;
  RestServer.DB.LockingMode := lmExclusive;
  RestServer.CreateMissingTables;

  RestServer.ServiceDefine(TServiceShell, [IShell], sicSingle);

  HttpServer := TSQLHttpServer.Create(PORT_NAME, [RestServer], '+', HTTP_DEFAULT_MODE);
  HttpServer.AccessControlAllowOrigin := '*'; // allow cross-site AJAX queries

  SimpleEvent := TSimpleEvent.Create;
  while true do begin
    SynTable.FixedWaitFor(SimpleEvent, 30 * 1000);
    SimpleEvent.ResetEvent;
	end;

  HttpServer.Free;
  RestServer.Free;
  Model.Free;

end.

ShellServer.lpi

<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
  <ProjectOptions>
    <Version Value="11"/>
    <General>
      <Flags>
        <MainUnitHasCreateFormStatements Value="False"/>
        <MainUnitHasScaledStatement Value="False"/>
      </Flags>
      <SessionStorage Value="InProjectDir"/>
      <MainUnit Value="0"/>
      <Title Value="My Application"/>
      <UseAppBundle Value="False"/>
      <ResourceType Value="res"/>
    </General>
    <BuildModes Count="3">
      <Item1 Name="Default" Default="True"/>
      <Item2 Name="Debug">
        <CompilerOptions>
          <Version Value="11"/>
          <Target>
            <Filename Value="Build/linux_x86_64_fpc_release/ShellServer"/>
          </Target>
          <SearchPaths>
            <IncludeFiles Value="$(ProjOutDir);../../../vendors/mORMot/;../../../vendors/mORMot/SQLite3/;"/>
            <OtherUnitFiles Value="../../../vendors/mORMot/;../../../vendors/mORMot/SQLite3/;"/>
            <UnitOutputDirectory Value="Build/linux_x86_64_fpc_release/units/"/>
          </SearchPaths>
          <Parsing>
            <SyntaxOptions>
              <IncludeAssertionCode Value="True"/>
            </SyntaxOptions>
          </Parsing>
          <CodeGeneration>
            <Checks>
              <IOChecks Value="True"/>
              <RangeChecks Value="True"/>
              <OverflowChecks Value="True"/>
              <StackChecks Value="True"/>
            </Checks>
            <VerifyObjMethodCallValidity Value="True"/>
            <TargetCPU Value="x86_64"/>
            <TargetOS Value="linux"/>
          </CodeGeneration>
          <Linking>
            <Debugging>
              <DebugInfoType Value="dsDwarf2Set"/>
              <UseHeaptrc Value="True"/>
              <TrashVariables Value="True"/>
              <UseExternalDbgSyms Value="True"/>
            </Debugging>
          </Linking>
        </CompilerOptions>
      </Item2>
      <Item3 Name="Release">
        <CompilerOptions>
          <Version Value="11"/>
          <Target>
            <Filename Value="Build/linux_x86_64_fpc_release/ShellServer"/>
          </Target>
          <SearchPaths>
            <IncludeFiles Value="$(ProjOutDir);../../../vendors/mORMot/;../../../vendors/mORMot/SQLite3/;"/>
            <OtherUnitFiles Value="../../../vendors/mORMot/;../../../vendors/mORMot/SQLite3/;"/>
            <UnitOutputDirectory Value="Build/linux_x86_64_fpc_release/units/"/>
          </SearchPaths>
          <CodeGeneration>
            <SmartLinkUnit Value="True"/>
            <TargetCPU Value="x86_64"/>
            <TargetOS Value="linux"/>
            <Optimizations>
              <OptimizationLevel Value="3"/>
            </Optimizations>
          </CodeGeneration>
          <Linking>
            <Debugging>
              <GenerateDebugInfo Value="False"/>
            </Debugging>
            <LinkSmart Value="True"/>
          </Linking>
        </CompilerOptions>
      </Item3>      
    </BuildModes>
    <PublishOptions>
      <Version Value="2"/>
    </PublishOptions>
    <RunParams>
      <FormatVersion Value="2"/>
      <Modes Count="0"/>
    </RunParams>
    <Units Count="1">
      <Unit0>
        <Filename Value="ShellServer.dpr"/>
        <IsPartOfProject Value="True"/>
      </Unit0>
    </Units>
    <RequiredPackages Count="1">
      <Item1>
        <PackageName Value="LCL"/>
      </Item1>
    </RequiredPackages>    
  </ProjectOptions>
  <CompilerOptions>
    <Version Value="11"/>
    <Target>
      <Filename Value="Build/linux_x86_64_fpc_release/ShellServer"/>
    </Target>
    <SearchPaths>
      <IncludeFiles Value="$(ProjOutDir);../../../vendors/mORMot/;../../../vendors/mORMot/SQLite3/;"/>
      <OtherUnitFiles Value="../../../vendors/mORMot/;../../../vendors/mORMot/SQLite3/;"/>
      <UnitOutputDirectory Value="Build/linux_x86_64_fpc_release/units/"/>
    </SearchPaths>
    <CodeGeneration>
      <TargetCPU Value="x86_64"/>
      <TargetOS Value="linux"/>
    </CodeGeneration>
  </CompilerOptions>
  <Debugging>
    <Exceptions Count="3">
      <Item1>
        <Name Value="EAbort"/>
      </Item1>
      <Item2>
        <Name Value="ECodetoolError"/>
      </Item2>
      <Item3>
        <Name Value="EFOpenError"/>
      </Item3>
    </Exceptions>
  </Debugging>
</CONFIG>

uShellInterfaceDef.pas

/// some common definitions shared by both client and server side
unit uShellInterfaceDef;         
{$I Synopse.inc} // define HASINLINE USETYPEINFO CPU32 CPU64 OWNNORMTOUPPER
{$IFOPT D+} {$DEFINE DEBUG} {$ENDIF}
{$ASSERTIONS ON}

interface

uses
  SysUtils, Classes,

  mORMot;

type
{$M+}

  IShell = interface(IInvokable)
    ['{ab800a2d-2d52-4d41-9863-f63c63574d14}']
    procedure Run(const ShellCmd: string; var StdOutput, StdError: TStringList);
  end;

const
  ROOT_NAME = 'root';
  PORT_NAME = '18182';

implementation

initialization

  // so that we could use directly ICalculator instead of TypeInfo(ICalculator)
  TInterfaceFactory.RegisterInterfaces([TypeInfo(IShell)]);

end.

uShellInterfaceImpl.pas

/// server-side interface implementations
unit uShellInterfaceImpl;        
{$I Synopse.inc} // define HASINLINE USETYPEINFO CPU32 CPU64 OWNNORMTOUPPER
{$IFOPT D+} {$DEFINE DEBUG} {$ENDIF}
{$ASSERTIONS ON}

interface

uses
  SysUtils, Classes,

  SynCommons, SynLog,

  IPC, BaseUnix, Unix, Process, FileUtil,

  uShellInterfaceDef;

type
{$M+}

  { TServiceShell }

  TServiceShell = class(TInterfacedObject, IShell)
  public                     
    procedure Run(const ShellCmd: string; var StdOutput, StdError: TStringList);
  end;

implementation

{ TServiceShell }

procedure TServiceShell.Run(const ShellCmd: string; var StdOutput, StdError: TStringList);
var
  outputstring: string;
  StdOutputCopy, StdErrorCopy: TStringList;
begin
  StdOutputCopy := nil;
  StdErrorCopy := nil;
  try
    StdOutputCopy := TStringList.Create;
    StdErrorCopy := TStringList.Create;

    RunCommand('bash', ['-c', ShellCmd], outputstring);
    StdOutputCopy.Text := outputstring;
 
    StdOutput.Assign(StdOutputCopy);
    StdError.Assign(StdErrorCopy);

  finally
    StdOutputCopy.Free;
    StdErrorCopy.Free;
  end;
end;

end.