////////////////////////////////////////////////////////////////////////////////
// Copyright (c) 2001-2026 Alexey Kuryakin daqgroup@mail.ru under MIT license //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// This file is part of the CRW-DAQ project by DaqGroup - component CRWLIB.   //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// This unit implement DAQ ZMQ Server.                                        //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20260630 - Created by A.K.                                                 //
////////////////////////////////////////////////////////////////////////////////

unit _crw_daqzmqsrv; // DAQ ZMQ Server.

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

interface

uses
 //////////////////////////////////////////////////////
 {$I _crw_uses_first.inc} // NB: MUST BE FIRST USES !!!
 //////////////////////////////////////////////////////
 sysutils, classes, math, forms,
 _crw_alloc, _crw_fpu, _crw_rtc, _crw_fifo, _crw_ef,
 _crw_str, _crw_fio, _crw_dynar, _crw_polling, _crw_base64,
 _crw_proc, _crw_task, _crw_regexp, _crw_dbglog, _crw_iana,
 _crw_daqtags, _crw_environ, _crw_sesman, _crw_hl,
 _crw_zmqman, _crw_zmqapi;

 {
 Commands are multipart ZMQ messages.
 From client side:
  Tx[0] - command name (started from @).
  Tx[1] - 1-st argument of command.
  Tx[i] - i-th argument of command.
  Rx[0] - command readback received. ?COMMAND or !COMMAND means unknown/error.
  Rx[1] - 1-st result of command.
  Rx[i] - i-th result of command.
 Commands:
 | @COMMAND   | Tx[…] Request arg  | Rx[…] Reply data                          |
 |------------|--------------------|-------------------------------------------|
 | @Help      | no                 | List of commands @COMMAND=(Comment text)  |
 | @Pulse     | no                 | Rx[1]=PulseNum. Internal heartbeat pulse. |
 | @Terminate | no                 | Rx[1]=ExitCode. Terminate (exit) server.  |
 | @Exit      | no                 | Rx[1]=ExitCode. Terminate (exit) server.  |
 | @SysEval   | Tx[1+]=commands    | Rx[1]=Sent bytes. Send $* to MainConsole. |
 | @DaqState  | no                 | Rx[1]=DAQ state: STOPPED|STANDBY|RUNNING. |
 | @DaqInfo   | no                 | Rx[*]=DAQ state and environment.          |
 | @ListTags  | no                 | Rx[1]=list DAQ tags: NAME=REF,TYPE+EOL    |
 | @GetTag    | Tx[1]=tag name/ref | Rx[1]=tag value as string REF=VALUE.      |
 | @GetTags   | Tx[1]=tag id list  | Rx[1]=tag values as string REF=VALUE+EOL  |
 | @GetTags   | Tx[1]=/pattern/    | Rx[1]=tag values as string NAME=VALUE+EOL |
 }
type
 TCrwDaqZmqServer = class;
 TCrwDaqZmqServerThread = class;
 TCrwDaqZmqCmdHandler=function(aServer:TCrwDaqZmqServer; Rx,Tx:TStringList):Boolean;
 TCrwDaqZmqServerThread = class(TThread)
 private
  mySockId    : Integer;
  myServer    : TCrwDaqZmqServer;
  myRxBuff    : TStringList;
  myTxBuff    : TStringList;
  myCmdTab    : THashList;
  myCmdMan    : TStringList;
  myPulseNum  : PtrUInt;
  myExitCode  : Integer;
  myBindings  : LongString;
  myConnected : Integer;
  procedure SockIdFree;
  procedure ApplyServerSockOpt;
  procedure NotifyOnTerminate(Sender:TObject);
 protected
  property SockId:Integer read mySockId;
  property Server:TCrwDaqZmqServer read myServer;
  property RxBuff:TStringList read myRxBuff;
  property TxBuff:TStringList read myTxBuff;
  property CmdTab:THashList   read myCmdTab;
  property CmdMan:TStringList read myCmdMan;
  property ExitCode:Integer   read myExitCode write myExitCode;
  property PulseNum:PtrUInt   read myPulseNum write myPulseNum;
  property Connected:Integer read myConnected;
  property Bindings:LongString read myBindings;
 protected
  procedure InitCmdTab;
  function  AddCmdHandler(aCmd:LongString; aHandler:TCrwDaqZmqCmdHandler; aMan:LongString):Boolean;
  function  RunCmdHandler(aCmd:LongString; Rx,Tx:TStringList):Boolean;
 public
  constructor Create(aSuspended:Boolean; aServer:TCrwDaqZmqServer);
  destructor  Destroy; override;
  procedure   AfterConstruction; override;
  procedure   BeforeDestruction; override;
 public
  procedure Execute; override;
 end;
 TCrwDaqZmqServer = class(TMasterObject)
 private
  myPort   : Integer;
  myPulser : Integer;
  myPulsRx : TStringList;
  myPulsTx : TStringList;
  myWorker : TCrwDaqZmqServerThread;
  myPoller : TPolling;
  myConn   : LongString;
 private
  function  GetPort:Integer;
  function  GetPulser:Integer;
  function  GetPoller:TPolling;
  function  GetStarted:Boolean;
  function  GetConnected:Integer;
  function  GetBindings:LongString;
  procedure PulserFree;
  procedure ApplyPulserSockOpt;
  function  GetMonitoring:Boolean;
  procedure SetMonitoring(Up:Boolean);
  function  WaitForStart(aTimeout:Integer):Boolean;
  procedure UpdatePulserConnect;
 protected
  property  PulsRx:TStringList read myPulsRx;
  property  PulsTx:TStringList read myPulsTx;
  property  Worker:TCrwDaqZmqServerThread read myWorker;
 public
  property  Monitoring:Boolean read GetMonitoring write SetMonitoring;
  function  MakeRequest(Soc:Integer; Rx,Tx:TStringList):Boolean;
  function  SendTerminate(aExitCode:Integer=-1; aTimeout:Integer=-1):Boolean;
  function  PulserPoll(aCommand:LongString=''):Boolean;
  procedure HandleAsyncPoll(Data:PtrInt);
  function  QueueAsyncPoll:Boolean;
 public
  constructor Create(aPort:Integer);
  destructor  Destroy; override;
  procedure   AfterConstruction; override;
  procedure   BeforeDestruction; override;
 public
  property  Port:Integer read GetPort;
  property  Pulser:Integer read GetPulser;
  property  Poller:TPolling read GetPoller;
  property  Started:Boolean read GetStarted;
  property  Connected:Integer read GetConnected;
  property  Bindings:LongString read GetBindings;
 public
  class var BasePortNumber:Integer;
  class var TimeoutToStart:Integer;
  class var TimeoutToTerminate:Integer;
  class var ServerSockOpt:LongString;
  class var PulserSockOpt:LongString;
 public
  class function  SessionPortNumber:Integer;
  class procedure ReadIniDefaultParams;
 end;

 //////////////////////////////////////////////////////////
 // DaqZmqSrv is the only one instance of TCrwDaqZmqServer.
 // Use DaqZmqSrv(PN) to init server on port number PN.
 // Use DaqZmqSrv     to access to server.
 // Use DaqZmqSrv(-1) to kill server.
 //////////////////////////////////////////////////////////
function DaqZmqSrv(aPort:Integer=0):TCrwDaqZmqServer;

 // Service routines
procedure Init_DaqZmqSrvSubsystem;
procedure Free_DaqZmqSrvSubsystem;

 // DebugLog channels
function dlc_DaqZmqLog:Integer;
function dlc_DaqZmqBug:Integer;
function dlc_DaqZmqPing:Integer;
function dlc_DaqZmqRxTx:Integer;

implementation

uses
 _crw_daqdev,
 _crw_daqsys,
 _crw_uhints,
 _crw_daqpascaldevice;

//////////////////
// Logger routines
//////////////////

function dlc_DaqZmqLog:Integer;
const dlc:Integer=0;
begin
 if (dlc=0) then dlc:=RegisterDebugLogChannel('_DaqZmqLog');
 Result:=dlc;
end;

function dlc_DaqZmqBug:Integer;
const dlc:Integer=0;
begin
 if (dlc=0) then dlc:=RegisterDebugLogChannel('_DaqZmqBug');
 Result:=dlc;
end;

function dlc_DaqZmqPing:Integer;
const dlc:Integer=0;
begin
 if (dlc=0) then dlc:=RegisterDebugLogChannel('_DaqZmqPing');
 Result:=dlc;
end;

function dlc_DaqZmqRxTx:Integer;
const dlc:Integer=0;
begin
 if (dlc=0) then dlc:=RegisterDebugLogChannel('_DaqZmqRxTx');
 Result:=dlc;
end;

////////////////////
// Service routines.
////////////////////

procedure Init_DaqZmqSrvSubsystem;
begin
 TCrwDaqZmqServer.ReadIniDefaultParams;
end;

procedure Free_DaqZmqSrvSubsystem;
begin
 DaqZmqSrv(-1);
end;

procedure DaqZmqSrvPoller(aPolling:TPolling; var Terminate:Boolean);
var Obj:TObject;
begin
 if Assigned(aPolling) then
 try
  Obj:=aPolling.LinkObject;
  if (Obj is TCrwDaqZmqServer)
  then TCrwDaqZmqServer(Obj).QueueAsyncPoll;
 except
  on E:Exception do BugReport(E,nil,'DaqZmqSrvPoller');
 end;
end;

///////////////////////////
// Internal helper routines
///////////////////////////

function SafeLinesCount(aLines:TStringList):Integer;
begin
 if (aLines<>nil)
 then Result:=aLines.Count
 else Result:=0;
end;

function SafeLinesGet(aLines:TStringList; aIndex:Integer):LongString;
begin
 if (aLines<>nil) and (aIndex>=0) and (aIndex<aLines.Count)
 then Result:=aLines.Strings[aIndex]
 else Result:='';
end;

procedure SafeLinesAdd(aLines:TStringList; const aLine:LongString);
begin
 if (aLines<>nil)
 then aLines.Add(aLine);
end;

procedure SafeLinesDelete(aLines:TStringList; aIndex:Integer);
begin
 if (aLines<>nil) and (aIndex>=0) and (aIndex<aLines.Count)
 then aLines.Delete(aIndex);
end;

//////////////////////////////////
// TCrwDaqZmqServerThread handlers
//////////////////////////////////

function zCheckValidArg(Server:TCrwDaqZmqServer;
                        Rx,Tx:TStringList;
                        narg:Integer):Boolean; inline;
begin
 Result:=Assigned(Server)
     and Assigned(Server.Worker)
     and Assigned(Rx)
     and Assigned(Tx)
     and (Rx.Count>narg);
end;

function zcmd_Help(Server:TCrwDaqZmqServer; Rx,Tx:TStringList):Boolean;
var cmd:LongString; const narg=0; // Command & number of arguments required
begin
 Result:=False;
 if zCheckValidArg(Server,Rx,Tx,narg) then
 try
  cmd:=Rx[0];
  if SameText(cmd,'@Help') then begin
   Tx.Add(cmd);
   Tx.Add(Server.Worker.CmdMan.Text);
   Result:=True;
  end;
 except
  on E:Exception do BugReport(E,Server,'zcmd_Help');
 end;
end;

function zcmd_Ping(Server:TCrwDaqZmqServer; Rx,Tx:TStringList):Boolean;
var cmd:LongString; const narg=0; // Command & number of arguments required
var i:Integer;
begin
 Result:=False;
 if zCheckValidArg(Server,Rx,Tx,narg) then
 try
  cmd:=Rx[0];
  if SameText(cmd,'@Ping') then begin
   Tx.Add(cmd);
   for i:=1 to Rx.Count-1 do Tx.Add(Rx[i]);
   Result:=True;
  end;
 except
  on E:Exception do BugReport(E,Server,'zcmd_Ping');
 end;
end;

function zcmd_Pulse(Server:TCrwDaqZmqServer; Rx,Tx:TStringList):Boolean;
var cmd:LongString; const narg=0; // Command & number of arguments required
begin
 Result:=False;
 if zCheckValidArg(Server,Rx,Tx,narg) then
 try
  cmd:=Rx[0];
  if SameText(cmd,'@Pulse') then begin
   Tx.Add(cmd);
   Tx.Add(IntToStr(Server.Worker.PulseNum));
   Server.Worker.PulseNum:=Server.Worker.PulseNum+1;
   Result:=True;
  end;
 except
  on E:Exception do BugReport(E,Server,'zcmd_Pulse');
 end;
end;

function zcmd_Terminate(Server:TCrwDaqZmqServer; Rx,Tx:TStringList):Boolean;
var cmd:LongString; const narg=0; // Command & number of arguments required
var ecode:Integer;
begin
 Result:=False;
 if zCheckValidArg(Server,Rx,Tx,narg) then
 try
  cmd:=Rx[0]; ecode:=0;
  if SameText(cmd,'@Terminate') then begin
   Tx.Add(cmd);
   if TryStrToInt(ExtractWord(2,Rx.Text,ScanSpaces),ecode)
   then Server.Worker.ExitCode:=ecode;
   Tx.Add(IntToStr(Server.Worker.ExitCode));
   Server.Worker.Terminate;
   Result:=True;
  end;
 except
  on E:Exception do BugReport(E,Server,'zcmd_Terminate');
 end;
end;

function zcmd_Exit(Server:TCrwDaqZmqServer; Rx,Tx:TStringList):Boolean;
var cmd:LongString; const narg=0; // Command & number of arguments required
var ecode:Integer;
begin
 Result:=False;
 if zCheckValidArg(Server,Rx,Tx,narg) then
 try
  cmd:=Rx[0];
  if SameText(cmd,'@Exit') then begin
   Tx.Add(cmd);
   if TryStrToInt(ExtractWord(2,Rx.Text,ScanSpaces),ecode)
   then Server.Worker.ExitCode:=ecode;
   Tx.Add(IntToStr(Server.Worker.ExitCode));
   Server.Worker.Terminate;
   Result:=True;
  end;
 except
  on E:Exception do BugReport(E,nil,'zcmd_Exit');
 end;
end;

function zcmd_SysEval(Server:TCrwDaqZmqServer; Rx,Tx:TStringList):Boolean;
var cmd:LongString; const narg=1; // Command & number of arguments required
var msg:LongString; len:Integer;
begin
 Result:=False;
 if zCheckValidArg(Server,Rx,Tx,narg) then
 try
  cmd:=Rx[0];
  if SameText(cmd,'@SysEval') then begin
   Tx.Add(cmd);
   msg:=SkipWords(1,Rx.Text,EolnDelims);
   len:=SendToMainConsole(Msg+EOL);
   Tx.Add(IntToStr(len));
   Result:=True;
  end;
 except
  on E:Exception do BugReport(E,nil,'zcmd_SysEval');
 end;
end;

function GetDaqState:LongString;
begin
 Result:='STOPPED';
 if Daq.IsSessionStarted then Result:='STANDBY';
 if Daq.IsAcquisitionStarted then Result:='RUNNING';
end;

function zcmd_DaqState(Server:TCrwDaqZmqServer; Rx,Tx:TStringList):Boolean;
var cmd:LongString; const narg=0; // Command & number of arguments required
begin
 Result:=False;
 if zCheckValidArg(Server,Rx,Tx,narg) then
 try
  cmd:=Rx[0];
  if SameText(cmd,'@DaqState') then begin
   Tx.Add(cmd);
   Tx.Add('DaqState='+GetDaqState);
   Result:=True;
  end;
 except
  on E:Exception do BugReport(E,Server,'zcmd_DaqState');
 end;
end;

function GetDaqInfo:LongString;
var Lines:TStringList; i:Integer; s:LongString;
begin
 Result:='';
 try
  Lines:=TStringList.Create;
  if Assigned(Lines) then
  try
   Lines.UseLocale:=False;
   Lines.Add('DaqState='+GetDaqState);
   for i:=0 to EnvironmentVariableList.Count-1 do begin
    s:=EnvironmentVariableList.Strings[i];
    if StartsText('CRW_DAQ',s) then Lines.Add(s);
   end;
   { Done }
   Result:=Lines.Text;
  finally
   Kill(Lines);
  end;
 except
  on E:Exception do BugReport(E,nil,'GetDaqInfo');
 end;
end;

function zcmd_DaqInfo(Server:TCrwDaqZmqServer; Rx,Tx:TStringList):Boolean;
var cmd:LongString; const narg=0; // Command & number of arguments required
begin
 Result:=False;
 if zCheckValidArg(Server,Rx,Tx,narg) then
 try
  cmd:=Rx[0];
  if SameText(cmd,'@DaqInfo') then begin
   Tx.Add(cmd);
   Tx.Add(GetDaqInfo);
   Result:=True;
  end;
 except
  on E:Exception do BugReport(E,Server,'zcmd_DaqInfo');
 end;
end;

function EvalTagList:LongString;
var Lines:TStringList; tag:Integer;
begin
 Result:='';
 try
  Lines:=TStringList.Create;
  try
   for tag:=TAG_REF_MIN to TAG_REF_MAX do
   case TypeTag(tag) of
    tag_type_int:    Lines.Add(NameTag(tag)+'='+IntToStr(tag)+',int');
    tag_type_real:   Lines.Add(NameTag(tag)+'='+IntToStr(tag)+',real');
    tag_type_string: Lines.Add(NameTag(tag)+'='+IntToStr(tag)+',str');
    else             Break;
   end;
   Result:=Lines.Text;
   if IsEmptyStr(Result) then Result:='<EMPTY>';
  finally
   Kill(Lines);
  end;
 except
  on E:Exception do BugReport(E,nil,'EvalTagList');
 end;
end;

function zcmd_ListTags(Server:TCrwDaqZmqServer; Rx,Tx:TStringList):Boolean;
var cmd:LongString; const narg=0; // Command & number of arguments required
begin
 Result:=False;
 if zCheckValidArg(Server,Rx,Tx,narg) then
 try
  cmd:=Rx[0];
  if SameText(cmd,'@ListTags') then begin
   Tx.Add(cmd);
   Tx.Add(EvalTagList);
   Result:=True;
  end;
 except
  on E:Exception do BugReport(E,Server,'zcmd_ListTags');
 end;
end;

function FormatTag(out Line:LongString; tag:Integer; numeric:Boolean):Boolean;
begin
 Result:=False; Line:='';
 if (tag=0) then Exit;
 if numeric then begin
  case TypeTag(tag) of
   tag_type_int:    Line:=Format('%d=%d',[tag,iGetTag(tag)]);
   tag_type_real:   Line:=Format('%d=%g',[tag,rGetTag(tag)]);
   tag_type_string: Line:=Format('%d=%s',[tag,sGetTag(tag)]);
   else             Exit;
  end;
 end else begin
  case TypeTag(tag) of
   tag_type_int:    Line:=Format('%s=%d',[NameTag(tag),iGetTag(tag)]);
   tag_type_real:   Line:=Format('%s=%g',[NameTag(tag),rGetTag(tag)]);
   tag_type_string: Line:=Format('%s=%s',[NameTag(tag),sGetTag(tag)]);
   else             Exit;
  end;
 end;
 Result:=True;
end;

function zcmd_GetTag(Server:TCrwDaqZmqServer; Rx,Tx:TStringList):Boolean;
var cmd:LongString; const narg=1; // Command & number of arguments required
var tag:Integer; arg1,Line:LongString; numeric:Boolean;
begin
 Result:=False;
 if zCheckValidArg(Server,Rx,Tx,narg) then
 try
  cmd:=Rx[0]; arg1:=Rx[1];
  if SameText(cmd,'@GetTag') then begin
   Tx.Add(cmd);
   tag:=0; numeric:=False; Line:='';
   if TryStrToInt(arg1,tag) then numeric:=True else tag:=FindTag(arg1);
   if FormatTag(Line,tag,numeric) then Tx.Add(Line) else Exit;
   Result:=True;
  end;
 except
  on E:Exception do BugReport(E,nil,'zcmd_GetTag');
 end;
end;

function zcmd_GetTags(Server:TCrwDaqZmqServer; Rx,Tx:TStringList):Boolean;
var cmd:LongString; const narg=1; // Command & number of arguments required
var tag,iw,rex:Integer; wi,args,Line:LongString; numeric:Boolean;
begin
 Result:=False;
 if zCheckValidArg(Server,Rx,Tx,narg) then
 try
  cmd:=Rx[0]; args:=Rx.Text; Line:='';
  if SameText(cmd,'@GetTags') then begin
   Tx.Add(cmd);
   if (CountChars(args,['/'])>1) then begin
    rex:=regexp_init(0,Trim(Rx[1]));
    if (rex<>0) then
    try
     for tag:=TAG_REF_MIN to TAG_REF_MAX do begin
      if (TypeTag(tag)=0) then Break;
      if not IsLexeme(NameTag(tag),rex) then continue;
      if FormatTag(Line,tag,False) then Tx.Add(Line);
     end;
    finally
     regexp_free(rex);
    end;
   end else
   for iw:=2 to WordCount(args,ScanSpaces) do begin
    wi:=ExtractWord(iw,args,ScanSpaces);
    tag:=0; numeric:=False;
    if TryStrToInt(wi,tag) then numeric:=True else tag:=FindTag(wi);
    if FormatTag(Line,tag,numeric) then Tx.Add(Line);
   end;
   Result:=(Tx.Count>1);
  end;
 except
  on E:Exception do BugReport(E,Server,'zcmd_GetTags');
 end;
end;

function FormatTagHints(out Line:LongString; tag:Integer; numeric:Boolean):Boolean;
var id,lng,key,val:LongString; iw:Integer;
begin
 Result:=False; Line:='';
 if (tag=0) or (TypeTag(tag)=0) then Exit;
 id:=NameTag(tag); if IsEmptyStr(id) then Exit;
 for iw:=1 to WordCount(DaqUserHints.Languages,ScanSpaces) do begin
  lng:=ExtractWord(iw,DaqUserHints.Languages,ScanSpaces);
  key:='Tag '+id;
  if DaqUserHints.HasUserHints[lng,key] then begin
   val:=DaqUserHints[lng,key];
   if IsNonEmptyStr(val) then begin
    Line+=(lng+' '+key+'='+val+EOL);
    continue;
   end;
  end;
  key:=id;
  if DaqUserHints.HasUserHints[lng,key] then begin
   val:=DaqUserHints[lng,key];
   if IsNonEmptyStr(val) then begin
    Line+=(lng+' '+key+'='+val+EOL);
    continue;
   end;
  end;
 end;
 if IsEmptyStr(Line) then Exit;
 Line:=TrimRightChars(Line,EolnDelims);
 Result:=True;
end;

function zcmd_GetTagsHints(Server:TCrwDaqZmqServer; Rx,Tx:TStringList):Boolean;
var cmd:LongString; const narg=1; // Command & number of arguments required
var tag,iw,rex:Integer; wi,args,Line:LongString; numeric:Boolean;
begin
 Result:=False;
 if zCheckValidArg(Server,Rx,Tx,narg) then
 try
  cmd:=Rx[0]; args:=Rx.Text; Line:='';
  if SameText(cmd,'@GetTagsHints') then begin
   Tx.Add(cmd);
   if (CountChars(args,['/'])>1) then begin
    rex:=regexp_init(0,Trim(Rx[1]));
    if (rex<>0) then
    try
     for tag:=TAG_REF_MIN to TAG_REF_MAX do begin
      if (TypeTag(tag)=0) then Break;
      if not IsLexeme(NameTag(tag),rex) then continue;
      if FormatTagHints(Line,tag,False) then Tx.Add(Line);
     end;
    finally
     regexp_free(rex);
    end;
   end else
   for iw:=2 to WordCount(args,ScanSpaces) do begin
    wi:=ExtractWord(iw,args,ScanSpaces);
    tag:=0; numeric:=False;
    if TryStrToInt(wi,tag) then numeric:=True else tag:=FindTag(wi);
    if FormatTagHints(Line,tag,numeric) then Tx.Add(Line);
   end;
   Result:=(Tx.Count>1);
  end;
 except
  on E:Exception do BugReport(E,Server,'zcmd_GetTagsHints');
 end;
end;

function zcmd_DevPost(Server:TCrwDaqZmqServer; Rx,Tx:TStringList):Boolean;
var cmd:LongString; const narg=1; // Command & number of arguments required
var msg,arg,den:LongString; len:Integer; dev:TDaqDevice;
begin
 Result:=False;
 if zCheckValidArg(Server,Rx,Tx,narg) then
 try
  if not Daq.IsAcquisitionStarted then Exit;
  cmd:=Rx[0];
  if SameText(cmd,'@DevPost') then begin
   Tx.Add(cmd);
   arg:=Trim(Rx.Text);
   den:=ExtractWord(2,arg,ScanSpaces);
   dev:=FullDaqDeviceList.Find(den);
   if (dev is TProgramDevice) then begin
    msg:=Trim(SkipWords(2,arg,ScanSpaces));
    len:=Round(TProgramDevice(dev).DaqPascal._devpost(dev.Ref,msg+EOL));
    Tx.Add(IntToStr(len));
    Result:=True;
   end;
  end;
 except
  on E:Exception do BugReport(E,nil,'zcmd_DevPost');
 end;
end;

function zcmd_DevSend(Server:TCrwDaqZmqServer; Rx,Tx:TStringList):Boolean;
var cmd:LongString; const narg=1; // Command & number of arguments required
var msg,arg,den:LongString; len:Integer; dev:TDaqDevice;
begin
 Result:=False;
 if zCheckValidArg(Server,Rx,Tx,narg) then
 try
  if not Daq.IsAcquisitionStarted then Exit;
  cmd:=Rx[0];
  if SameText(cmd,'@DevSend') then begin
   Tx.Add(cmd);
   arg:=Trim(Rx.Text);
   den:=ExtractWord(2,arg,ScanSpaces);
   dev:=FullDaqDeviceList.Find(den);
   if (dev is TProgramDevice) then begin
    msg:=Trim(SkipWords(2,arg,ScanSpaces));
    len:=Round(TProgramDevice(dev).DaqPascal._devsend(dev.Ref,msg+EOL));
    Tx.Add(IntToStr(len));
    Result:=True;
   end;
  end;
 except
  on E:Exception do BugReport(E,nil,'zcmd_DevSend');
 end;
end;

////////////////////////////////////////
// TCrwDaqZmqServerThread implementation
////////////////////////////////////////

constructor TCrwDaqZmqServerThread.Create(aSuspended:Boolean; aServer:TCrwDaqZmqServer);
begin
 inherited Create(aSuspended);
 myServer:=aServer;
 myRxBuff:=TStringList.Create;
 myRxBuff.UseLocale:=False;
 myTxBuff:=TStringList.Create;
 myTxBuff.UseLocale:=False;
 myCmdTab:=NewHashList(False,HashList_DefaultHasher);
 myCmdTab.OwnsObjects:=False; // NB!
 myCmdTab.Master:=@myCmdTab;
 myCmdMan:=TStringList.Create;
 myCmdMan.UseLocale:=False;
 OnTerminate:=NotifyOnTerminate;
end;

destructor TCrwDaqZmqServerThread.Destroy;
begin
 Kill(myRxBuff);
 Kill(myTxBuff);
 Kill(myCmdTab);
 Kill(myCmdMan);
 myBindings:='';
 inherited;
end;

procedure TCrwDaqZmqServerThread.SockIdFree;
begin
 if Assigned(Self) then
 try
  if (mySockId<>0) then begin
   if smq_free(mySockId)
   then DebugLog(dlc_DaqZmqLog,'Done Socket Free')
   else DebugLog(dlc_DaqZmqBug,'Fail Socket Free');
   mySockId:=0;
  end;
 except
  on E:Exception do BugReport(E,Self,'SockIdFree');
 end;
end;

procedure TCrwDaqZmqServerThread.AfterConstruction;
begin
 inherited;
 InitCmdTab;
end;

procedure TCrwDaqZmqServerThread.BeforeDestruction;
begin
 inherited;
end;

procedure TCrwDaqZmqServerThread.InitCmdTab;
begin
 AddCmdHandler('@Help',zcmd_Help,'Help on crwdaq zmq server.');
 AddCmdHandler('@Ping',zcmd_Ping,'Ping responds with same data as in request (echo).');
 AddCmdHandler('@Pulse',zcmd_Pulse,'Pulse (heartbeat) for crwdaq zmq server.');
 AddCmdHandler('@Terminate',zcmd_Terminate,'Terminate (exit) crwdaq zmq server.');
 AddCmdHandler('@Exit',zcmd_Exit,'Exit (terminate) crwdaq zmq server.');
 AddCmdHandler('@DaqState',zcmd_DaqState,'Get DAQ state (short,fast).');
 AddCmdHandler('@DaqInfo',zcmd_DaqInfo,'Get DAQ state & environ information.');
 AddCmdHandler('@SysEval',zcmd_SysEval,'Send $* message to Main Console.');
 AddCmdHandler('@ListTags',zcmd_ListTags,'List DAQ tags as NAME=REF,TYPE.');
 AddCmdHandler('@GetTag',zcmd_GetTag,'Get DAQ $1 tag as REF=VALUE.');
 AddCmdHandler('@GetTags',zcmd_GetTags,'Get DAQ $1+ tags as REF=VALUE list.');
 AddCmdHandler('@GetTagsHints',zcmd_GetTagsHints,'Get DAQ $1+ tags user hints.');
 AddCmdHandler('@DevPost',zcmd_DevPost,'Post message $2+ to DAQ device $1.');
 AddCmdHandler('@DevSend',zcmd_DevSend,'Send message $2+ to DAQ device $1.');
end;

function TCrwDaqZmqServerThread.AddCmdHandler(aCmd:LongString; aHandler:TCrwDaqZmqCmdHandler; aMan:LongString):Boolean;
begin
 Result:=False;
 aCmd:=Trim(aCmd);
 aMan:=Trim(aMan);
 if Assigned(aHandler) then
 if IsLexeme(aCmd,lex_AtCmnd) then
 if (CmdTab.IndexOf(aCmd)<0) then
 try
  CmdTab.KeyedObjects[aCmd]:=TObject(@aHandler);
  CmdMan.Values[aCmd]:=aMan;
  Result:=True;
 except
  on E:Exception do BugReport(E,Self,'AddCmdHandler');
 end;
end;

function TCrwDaqZmqServerThread.RunCmdHandler(aCmd:LongString; Rx,Tx:TStringList):Boolean;
var Addr:Pointer; aHandler:TCrwDaqZmqCmdHandler absolute Addr;
begin
 Result:=False;
 if (aCmd<>'') and (Rx<>nil) and (Tx<>nil) then
 try
  Tx.Clear;
  Addr:=CmdTab.KeyedObjects[aCmd];
  if Assigned(Addr) then Result:=aHandler(Server,Rx,Tx);
 except
  on E:Exception do BugReport(E,Self,'RunCmdHandler');
 end;
end;

procedure TCrwDaqZmqServerThread.ApplyServerSockOpt;
var opt:LongString;
begin
 if IsEmptyStr(TCrwDaqZmqServer.ServerSockOpt) then Exit;
 opt:=smq_ctrl(SockId,'SockOpt='+TCrwDaqZmqServer.ServerSockOpt);
 DebugLog(dlc_DaqZmqLog,'Server SockOpt '+opt);
end;

procedure TCrwDaqZmqServerThread.NotifyOnTerminate(Sender:TObject);
begin
 DebugLog(dlc_DaqZmqLog,'Terminate Worker');
end;

procedure TCrwDaqZmqServerThread.Execute;
var nRx,nTx:Integer; Binded:Boolean;
 procedure UpdateCopyOfSocketParameters;
 var soc:TZmqSocket; sb:LongString;  nc:Integer;
 begin
  soc:=smq_ref(SockId);
  if Assigned(soc) then begin
   sb:=soc.Bindings; nc:=soc.Connected;
   if (sb<>Bindings) then myBindings:=sb;
   if (nc<>Connected) then myConnected:=nc;
  end;
 end;
begin
 if Assigned(Server) then
 try
  mySockId:=smq_init('zmq rep bind tcp://*:'+IntToStr(Server.Port));
  if (SockId<>0) then
  try
   Binded:=False;
   ApplyServerSockOpt;
   smq_ctrl(SockId,'IoMode=0');
   UpdateCopyOfSocketParameters;
   DebugLog(dlc_DaqZmqLog,'Socket Init IoMode '+smq_ctrl(SockId,'IoMode'));
   while not Terminated do begin
    UpdateCopyOfSocketParameters;
    if not Binded and (Bindings<>'') then begin
     DebugLog(dlc_DaqZmqLog,'Socket Bind '+Bindings);
     Binded:=True;
    end;
    if Server.Started then begin
     myRxBuff.Clear; myTxBuff.Clear;
     nRx:=smq_recv_multipart(SockId,RxBuff);
     if (nRx>0) then begin
      if DebugLogEnabled(dlc_DaqZmqRxTx) then begin
       if (RxBuff.Count>0)
       then DebugLog(dlc_DaqZmqRxTx,Format('Recv %d-part REQ: %s',[nRx,Trim(RxBuff[0])]))
       else DebugLog(dlc_DaqZmqRxTx,'Invalid smq_recv_multipart REQ.');
      end;
      if (RxBuff.Count>0) then begin
       RxBuff[0]:=Trim(RxBuff[0]);
       if not RunCmdHandler(RxBuff[0],RxBuff,TxBuff) then TxBuff.Clear;
       // If error found, TxBuff is empty, so mark error state using ! char
       if (TxBuff.Count=0) then begin
        if IsLexeme(RxBuff[0],lex_AtCall) then begin
         if (CmdTab.IndexOf(RxBuff[0])<0)
         then TxBuff.Add(StringReplace(RxBuff[0],'@','?',[]))
         else TxBuff.Add(StringReplace(RxBuff[0],'@','!',[]));
        end else begin
         TxBuff.Add('?'+RxBuff[0]);
        end;
       end;
       nTx:=smq_send_multipart(SockId,TxBuff);
       if (nTx>0) then begin
        if DebugLogEnabled(dlc_DaqZmqRxTx) then begin
         if (TxBuff.Count>0)
         then DebugLog(dlc_DaqZmqRxTx,Format('Sent %d-part REP: %s',[nTx,Trim(TxBuff[0])]))
         else DebugLog(dlc_DaqZmqRxTx,'Invalid smq_send_multipart REP.');
        end;
       end else begin
        DebugLog(dlc_DaqZmqBug,'Failed smq_send_multipart REP.');
       end;
      end;
     end else begin
      Sleep(TPolling.DefPollPeriod);
     end;
    end else begin
     Sleep(TPolling.DefPollPeriod);
    end;
   end;
  finally
   SockIdFree;
  end;
 except
  on E:Exception do BugReport(E,Self,'Execute');
 end;
 if not Terminated then Terminate;
end;

//////////////////////////////////
// TCrwDaqZmqServer implementation
//////////////////////////////////

constructor TCrwDaqZmqServer.Create(aPort:Integer);
begin
 inherited Create;
 myPort:=EnsureRange(aPort,0,$FFFF);
 myPoller:=NewPolling(DaqZmqSrvPoller,1000,tpNormal,False,'Daq.ZmqSrv.Poller');
 myPoller.Master:=@myPoller; myPoller.LinkObject:=Self; // NB!
 myWorker:=TCrwDaqZmqServerThread.Create(True,Self);
 myPulsRx:=TStringList.Create; PulsRx.UseLocale:=False;
 myPulsTx:=TStringList.Create; PulsTx.UseLocale:=False;
 myPulser:=smq_init('zmq req connect tcp://localhost:'+IntToStr(myPort));
end;

destructor TCrwDaqZmqServer.Destroy;
begin
 Kill(TObject(myWorker));
 Kill(myPoller);
 Kill(myPulsRx);
 Kill(myPulsTx);
 myConn:='';
 PulserFree;
 inherited;
end;

procedure TCrwDaqZmqServer.AfterConstruction;
begin
 inherited;
 Monitoring:=True;
 ApplyPulserSockOpt;
 Worker.Suspended:=False;
 smq_ctrl(Pulser,'IoMode=0');
 DebugLog(dlc_DaqZmqLog,Format('Pulser Init IoMode %d',[smq_ref(Pulser).IoMode]));
 WaitForStart(TimeoutToStart);
end;

procedure TCrwDaqZmqServer.BeforeDestruction;
begin
 Monitoring:=False;
 SendTerminate;
 inherited;
end;

procedure TCrwDaqZmqServer.PulserFree;
begin
 if Assigned(Self) then
 try
  if (myPulser<>0) then begin
   if smq_free(myPulser)
   then DebugLog(dlc_DaqZmqLog,'Done Pulser Free')
   else DebugLog(dlc_DaqZmqBug,'Fail Pulser Free');
   myPulser:=0;
  end;
 except
  on E:Exception do BugReport(E,Self,'PulserFree');
 end;
end;

function TCrwDaqZmqServer.GetPort:Integer;
begin
 if Assigned(Self)
 then Result:=myPort
 else Result:=0;
end;

function TCrwDaqZmqServer.GetPulser:Integer;
begin
 if Assigned(Self)
 then Result:=myPulser
 else Result:=0;
end;

function TCrwDaqZmqServer.GetPoller:TPolling;
begin
 if Assigned(Self)
 then Result:=myPoller
 else Result:=nil;
end;

function TCrwDaqZmqServer.GetConnected:Integer;
begin
 if Assigned(Self) and Assigned(Worker)
 then Result:=Worker.Connected
 else Result:=0;
end;

function TCrwDaqZmqServer.GetBindings:LongString;
begin
 if Assigned(Self) and Assigned(Worker)
 then Result:=Worker.Bindings
 else Result:='';
end;

function TCrwDaqZmqServer.GetStarted:Boolean;
begin
 Result:=False;
 if Assigned(Self) and Assigned(Worker) then begin
  if (Port=0) or (Worker.SockId=0) then Exit;
  if (Worker.Bindings='') then Exit;
  if Worker.Terminated then Exit;
  if Worker.Suspended then Exit;
  Result:=True;
 end;
end;

function TCrwDaqZmqServer.GetMonitoring:Boolean;
begin
 if Assigned(Self)
 then Result:=Poller.Enabled
 else Result:=False;
end;

procedure TCrwDaqZmqServer.SetMonitoring(Up:Boolean);
begin
 if Assigned(Self)
 then Poller.Enabled:=Up;
end;

procedure TCrwDaqZmqServer.ApplyPulserSockOpt;
var opt:LongString;
begin
 if IsEmptyStr(TCrwDaqZmqServer.PulserSockOpt) then Exit;
 opt:=smq_ctrl(Pulser,'SockOpt='+TCrwDaqZmqServer.PulserSockOpt);
 DebugLog(dlc_DaqZmqLog,'Pulser SockOpt '+opt);
end;

function TCrwDaqZmqServer.WaitForStart(aTimeout:Integer):Boolean;
var ms:Int64;
begin
 Result:=False;
 if Assigned(Self) then
 try
  ms:=IntMSecNow;
  aTimeout:=EnsureRange(aTimeout,0,5000);
  while (IntMSecNow-ms<aTimeout) do begin
   if Started and (smq_ref(Pulser).Connected>0) then Break;
   Sleep(TPolling.DefPollPeriod);
  end;
  UpdatePulserConnect;
  ms:=IntMSecNow-ms;
  Result:=Started;
  if DebugLogEnabled(dlc_DaqZmqLog) then begin
   if Result
   then DebugLog(dlc_DaqZmqLog,'Start takes '+IntToStr(ms)+' ms')
   else DebugLog(dlc_DaqZmqLog,'Start fails '+IntToStr(ms)+' ms');
  end;
 except
  on E:Exception do BugReport(E,Self,'WaitForStart');
 end;
end;

function TCrwDaqZmqServer.MakeRequest(Soc:Integer; Rx,Tx:TStringList):Boolean;
var nRx,nTx:Integer;
begin
 Result:=False;
 if IsMainThread then
 if Assigned(Self) and (Soc<>0) and (Rx<>nil) and (Tx<>nil) then
 try
  nRx:=0; nTx:=0;
  if not Started then Exit;
  if (Worker=nil) or Worker.Suspended or Worker.Terminated then Exit;
  if (Tx.Count=0) or not IsLexeme(Tx.Strings[0],lex_AtCmnd) then Exit;
  nTx:=smq_send_multipart(Soc,Tx);
  if (nTx>0) then begin
   if DebugLogEnabled(dlc_DaqZmqRxTx) then begin
    DebugLog(dlc_DaqZmqRxTx,'Sent '+IntToStr(nTx)+'-part REQ '
            +StringReplace(Tx.Text,EOL,' ',[rfReplaceAll]));
   end;
   nRx:=smq_recv_multipart(Soc,Rx);
   if (nRx>0) then begin
    if DebugLogEnabled(dlc_DaqZmqRxTx) then begin
     DebugLog(dlc_DaqZmqRxTx,'Recv '+IntToStr(nRx)+'-part REP '
             +StringReplace(Rx.Text,EOL,' ',[rfReplaceAll]));
    end;
   end;
  end;
  Result:=(nRx>0) and (nTx>0);
 except
  on E:Exception do BugReport(E,Self,'MakeRequest');
 end;
end;

procedure TCrwDaqZmqServer.UpdatePulserConnect;
var spc:LongString;
begin
 if Assigned(Self) then
 try
  spc:=smq_ref(Pulser).Connections;
  if (myConn<>spc) and (Pos('?',spc)=0) then begin
   DebugLog(dlc_DaqZmqLog,'Pulser Connect '+spc);
   myConn:=spc;
  end;
 except
  on E:Exception do BugReport(E,Self,'UpdatePulserConnect');
 end;
end;

function TCrwDaqZmqServer.PulserPoll(aCommand:LongString=''):Boolean;
var NeedPing:Boolean; PingTime:Double;
begin
 Result:=False;
 if IsMainThread then
 if Assigned(Self) then
 try
  PulsRx.Clear;
  aCommand:=TrimDef(aCommand,'@Pulse');
  if IsLexeme(aCommand,lex_AtCall) then begin
   PulsTx.Text:=aCommand;
   NeedPing:=DebugLogEnabled(dlc_DaqZmqPing);
   if NeedPing then PingTime:=MksecNow else PingTime:=0;
   Result:=MakeRequest(Pulser,PulsRx,PulsTx);
   if NeedPing then begin
    PingTime:=MksecNow-PingTime;
    DebugLog(dlc_DaqZmqPing,Format('DaqZmqSrv ping %1.0f mks',[PingTime]));
   end;
  end;
  if Result then UpdatePulserConnect;
 except
  on E:Exception do BugReport(E,Self,'PulserPoll');
 end;
end;

function TCrwDaqZmqServer.SendTerminate(aExitCode:Integer=-1; aTimeout:Integer=-1):Boolean;
var ms:Int64;
begin
 Result:=False;
 if IsMainThread then
 if Assigned(Self) then
 try
  if Started and Assigned(Worker) and not Worker.Suspended then begin
   ms:=IntMSecNow;
   if (aExitCode<0) then aExitCode:=Worker.ExitCode;
   if (aTimeOut<0) then aTimeout:=TimeoutToTerminate;
   while (IntMSecNow-ms<=aTimeOut) and not Worker.Terminated do begin
    if PulserPoll('@Terminate'+EOL+IntToStr(aExitCode))
    then Sleep(TPolling.DefPollPeriod)
    else Break;
   end;
   Result:=Worker.Terminated;
  end else begin
   Result:=True;
  end;
 except
  on E:Exception do BugReport(E,Self,'SendTerminate');
 end;
end;

procedure TCrwDaqZmqServer.HandleAsyncPoll(Data:PtrInt);
var Msg:LongString;
begin
 if IsMainThread then
 if Assigned(Self) then
 if (Self=ObjectRegistry[Data]) then
 try
  if Assigned(Worker) and Worker.Terminated then begin
   Msg:='DaqZmqSrv terminated with code '+IntToStr(Worker.ExitCode)+'.';
   DebugLog(dlc_DaqZmqLog,Msg);
   Echo(Msg);
   Free;
   Exit;
  end;
  PulserPoll;
 except
  on E:Exception do BugReport(E,nil,'HandleAsyncPoll');
 end;
end;

function TCrwDaqZmqServer.QueueAsyncPoll:Boolean;
begin
 Result:=False;
 if Assigned(Self) then
 try
  Application.QueueAsyncCall(HandleAsyncPoll,Ref);
  Result:=True;
 except
  on E:Exception do BugReport(E,Self,'QueueAsyncPoll');
 end;
end;

class function TCrwDaqZmqServer.SessionPortNumber:Integer;
begin
 Result:=BasePortNumber+SessionManager.SessionNb;
end;

class procedure TCrwDaqZmqServer.ReadIniDefaultParams;
const SectDaqZmqSrvServiceServerSockOpt='[DaqZmqSrv-Service-Server-SockOpt]';
const SectDaqZmqSrvServicePulserSockOpt='[DaqZmqSrv-Service-Pulser-SockOpt]';
const SectDaqZmqSrvService='[DaqZmqSrv-Service]';
var np,tm:Integer; Buff:LongString;
begin
 try
  np:=BasePortNumber;
  if ReadIniFileInteger(SysIniFile,SectDaqZmqSrvService,'BasePortNumber%i',np) then begin
   if InRange(np,Low(TIanaUserPorts),High(TIanaUserPorts))
   then BasePortNumber:=np;
  end;
  tm:=TimeoutToStart;
  if ReadIniFileInteger(SysIniFile,SectDaqZmqSrvService,'TimeoutToStart%i',tm) then begin
   if InRange(tm,100,5000)
   then TimeoutToStart:=tm;
  end;
  tm:=TimeoutToTerminate;
  if ReadIniFileInteger(SysIniFile,SectDaqZmqSrvService,'TimeoutToTerminate%i',tm) then begin
   if InRange(tm,100,60000)
   then TimeoutToTerminate:=tm;
  end;
  Buff:=ExtractTextSection(SysIniFile,SectDaqZmqSrvServiceServerSockOpt,efConfigNC);
  Buff:=ExtractZmqOptionsFromBuff(Buff,esComments);
  TCrwDaqZmqServer.ServerSockOpt:=Buff;
  Buff:=ExtractTextSection(SysIniFile,SectDaqZmqSrvServicePulserSockOpt,efConfigNC);
  Buff:=ExtractZmqOptionsFromBuff(Buff,esComments);
  TCrwDaqZmqServer.PulserSockOpt:=Buff;
 except
  on E:Exception do BugReport(E,nil,'ReadIniDefaultParams');
 end;
end;

///////////////////////////
// DaqZmqSrv implementation
///////////////////////////
function DaqZmqSrv(aPort:Integer=0):TCrwDaqZmqServer;
const LoPort=Low(TIanaUserPorts); HiPort=High(TIanaUserPorts);
const Srv:TCrwDaqZmqServer=nil;
begin
 if (aPort<>0) then Kill(TObject(Srv));
 if (Srv=nil) and InRange(aPort,LoPort,HiPort) then begin
  Srv:=TCrwDaqZmqServer.Create(aPort);
  Srv.Master:=@Srv;
 end;
 Result:=Srv;
end;

///////////////////////////////////////
// Unit initialization and finalization
///////////////////////////////////////

procedure Init_crw_daqzmqsrv;
begin
 dlc_DaqZmqLog;
 dlc_DaqZmqBug;
 dlc_DaqZmqPing;
 dlc_DaqZmqRxTx;
 TCrwDaqZmqServer.BasePortNumber:=4200;
 TCrwDaqZmqServer.TimeoutToStart:=1000;
 TCrwDaqZmqServer.TimeoutToTerminate:=5000;
end;

procedure Free_crw_daqzmqsrv;
begin
 DaqZmqSrv(-1);
 TCrwDaqZmqServer.ServerSockOpt:='';
 TCrwDaqZmqServer.PulserSockOpt:='';
end;

initialization

 Init_crw_daqzmqsrv;

finalization

 Free_crw_daqzmqsrv;

end.

//////////////
// END OF FILE
//////////////

