////////////////////////////////////////////////////////////////////////////////
// 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:                                                                   //
// Named pipes.                                                               //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20040420 - Creation                                                        //
// 20040422 - First tested release                                            //
// 20070220 - Reporter                                                        //
// 20230926 - Modified for FPC (A.K.)                                         //
// 20230927 - Merge with EasyIpc.                                             //
// 20231008 - FPC tested release                                              //
// 20240317 - ListenPeriod                                                    //
// 20240521 - _NamedPipe log channel                                          //
////////////////////////////////////////////////////////////////////////////////

unit _crw_pipe; // Names pipes.

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

{$WARN 5023 off : Unit "$1" not used in $2}
{$WARN 6058 off : Call to subroutine "$1" marked as inline is not inlined}

interface

uses
 //////////////////////////////////////////////////////
 {$I _crw_uses_first.inc} // NB: MUST BE FIRST USES !!!
 //////////////////////////////////////////////////////
 {$IFDEF UNIX} baseunix, unix, termio, sockets, {$ENDIF}
 sysutils, classes, math,
 _crw_alloc, _crw_fifo, _crw_rtc, _crw_str, _crw_fio, _crw_dynar, _crw_spcfld,
 _crw_hl, _crw_polling, _crw_dbglog;

 {
 *******************************************************************************
 Назначение.
  Этот модуль предназначен для работы с именованными каналами (NamedPipe).
  Связь по каналу сделана так, что возможен только один экземпляр канала,
  то есть только одна пара клиент-сервер с данным именем. В принципе, идеология
  каналов допускает работу с многими экземплярами каналов, но для предполагаемых
  приложений (прикладные задачи CRW-DAQ) это не подходит. Зато два экземпляра
  класса TPipe, клиент и сервер, автоматически устанавливают контакт и
  автоматически восстанавливают связь, если она была потеряна. Для измерительных
  задач это гораздо важнее.
 *******************************************************************************
 Принцип работы.
  Прост до предела. Всеми операциями I/O занимается отдельный поток, который
  общается с клиентским потоком через FIFO. Поток периодически сканирует канал и
  инициирует необходимые операции чтения/записи, беря данные из FIFO передатчика
  и помещая в FIFO приемника, а также регистрируя ошибки при помощи процедуры
  пользователя Report.
  При старте или при разрыве связи:
   - сервер закрывает канал и создает его снова
   - клиент периодически пытается открыть существующий канал
  Поэтому при разрыве связи она автоматически восстанавливается, когда возникают
  благоприятные условия. Это хорошо для случая, когда измерительная машина может
  работать автономно. Как только появилась связь с центральным сервером, канал
  тут же ее подхватывает. Удобно.
  Этот метод не блещет изощренностью, но представляется наиболее устойчивым к
  возможным сбоям, а кроме того, он проще, чем работа по событиям или сообщениям,
  а потому кажется предпочтительнее. Тем более, что нагрузка CPU при работе
  оказалась близка к 0 (диспетчер задач Windows 2000 показывает 0).
 *******************************************************************************
 Программирование.
  1) aHost - имя компьютера-сервера, с которым хочет связаться клиент.
     Чтобы запустить сервер, надо указать пустое имя компьютера aHost.
     Имя компьютера aHost='.' означает клиента на локальной машине.
  2) Для обмена данными используется FIFO RxFifo-приемник, TxFifo-передатчик.
     Для чтения данных из канала вызывается pipe.RxFifo.Get.
     Для записи данных в канал   вызывается pipe.TxFifo.Put.
  3) Опрос канала организуется через поток Polling.
     Для приостановки опроса используйте pipe.Polling.Enable(..)
  4) Для сообщений об ошибках задается callback процедура Report, кроме того,
     надо анализировать RxFifo.Lost,TxFifo.Lost.
  5) Все каналы регистрируются в списке FullPipeList.
  6) На низком уровне используются только стандартные средства Win32, поэтому
     надеюсь, что с переносимостью не будет проблем.
  7) Как выяснилось, каналы поддерживаются только под NT/W2K/XP.
 *******************************************************************************
 Конфигурирование.
  Конфигурация канала задается при его создании и далее не меняется.
  Можно конфигурировать канал через INI-файл:
  pipe:=NewPipeFromIniFile('example.cfg','[Pipe]')
   [Pipe]
   PipeName = test                 ; Pipe Name, Client
   PipeName = .\test               ; Pipe Name, Server
   FifoSize = 32                   ; Fifo size in KB
   PipePolling = 1, tpTimeCritical ; Polling thread
   TimeOut = 1000                  ; Timeout to check connection
 *******************************************************************************
 Пример программирования.
  Server:
   pipe:=NewPipe('','test');
   while not Terminated do begin
    write(pipe.RxFifo.GetText);      // Receive data...
    pipe.TxFifo.PutTex(GetUserData); // Transmit data ...
   end;
   Kill(pipe);
  Client:
   pipe:=NewPipe('host','test');
   while not Terminated do begin
    write(pipe.RxFifo.GetText);      // Receive data...
    pipe.TxFifo.PutTex(GetUserData); // Transmit data ...
   end;
   Kill(pipe);
 *******************************************************************************
 }

const
 DefPipeFactor   = 2;                                                           // Default Rx/TxFifo GrowFactor
 DefPipePriority = tpHigher;                                                    // Default pipe thread priority

type
 TPipe = class;                                                                 // Predefine pipe class
 TPipeReporter = procedure(                                                     // Proc. to report errors
                           Pipe:TPipe;                                          // Sender pipe
                           When:Double;                                         // When it happened
                     const What:LongString;                                     // What is happened
                           Code:Integer);                                       // Error code
 TPipe = class(TMasterObject)                                                   // Named pipe wrap class
 private
  myHostName  : LongString;                                                     // Peer host name (empty for server)
  myBaseName  : LongString;                                                     // Pipe base name (logic identifier)
  myFileName  : LongString;                                                      // Pipe file name (system dependent)
  myRxFifo    : TFifo;                                                          // Receiver FIFO
  myTxFifo    : TFifo;                                                          // Transmitter FIFO
  myPolling   : TPolling;                                                       // Polling thread
  myReporter  : TPipeReporter;                                                  // Proc. to report errors
  myConnected : Boolean;                                                        // Connected?
  {$IFDEF WINDOWS}
  myFile      : THandle;                                                        // Pipe file handle
  myRxPending : Boolean;                                                        // Receiver pending IO
  myTxPending : Boolean;                                                        // Transmitter pending IO
  myRxOverlap : TOverlapped;                                                    // Receiver overlap
  myTxOverlap : TOverlapped;                                                    // Transmitter overlap
  myRxBuffer  : packed array[0..1024*4-1] of char;                              // Receiver buffer
  myTxBuffer  : packed array[0..1024*4-1] of char;                              // Transmitter buffer
  mySecDesc   : TSecurityDescriptor;                                            // Security descriptor
  mySecAttr   : TSecurityAttributes;                                            // Security attributes
  {$ENDIF ~WINDOWS}
  {$IFDEF UNIX}
  mySock      : THandle;                                                        // Socket handle
  myConn      : THandle;                                                        // Connection (server)
  myRxBuff    : LongString;                                                     // Receiver buffer
  myTxBuff    : LongString;                                                     // Transmitter buffer
  {$ENDIF ~UNIX}
  myTimeOut   : Integer;                                                        // Timeout to check connection
  myRxLost    : Int64;                                                          // Last value of RxFifo.Lost
  myTxLost    : Int64;                                                          // Last value of TxFifo.Lost
  myLastTick  : QWord;                                                          // Every second tick
  myLastCheck : QWord;                                                          // Time when last check done
  myLogsHistory : Integer;                                                      // Logs history limit
  myLogsText    : TText;                                                        // Logs history text
  myListenPeriod : Integer;                                                     // Period to listen/accept incoming connections
 private
  function    GetHostName:LongString;
  function    GetBaseName:LongString;
  function    GetPipeName:LongString;
  function    GetFileName:LongString;
  function    InitFileName:LongString;
  function    GetIsServer:Boolean;
  function    GetIsClient:Boolean;
  function    GetRxFifo:TFifo;
  function    GetTxFifo:TFifo;
  function    GetPolling:TPolling;
  function    GetConnected:Boolean;
  function    GetTimeout:Integer;
  function    GetHandle(i:Integer=0):THandle;
  function    GetLogsText:TText;
  function    GetLogsHistory:Integer;
  function    GetLogsCount:Integer;
  function    GetLogsTextMove:LongString;
  function    GetLogsTextCopy:LongString;
  function    GetListenPeriod:Integer;
  procedure   SetListenPeriod(aPeriod:Integer);
  procedure   Report(const What:LongString; Code:Integer);
  procedure   SetReporter(aReporter:TPipeReporter);
  procedure   Close(aErrorCode:Integer=ERROR_SUCCESS; aRxLost:Integer=0; aTxLost:Integer=0);
  procedure   Poll;
 public
  constructor Create(const aHost : LongString;                                  // Host(client) or empty(server)
                     const aName : LongString;                                  // Pipe name
                     aReporter   : TPipeReporter;                               // Callback to report errors
                     aDelay      : Integer;                                     // Polling delay
                     aPriority   : TThreadPriority;                             // Thread priority
                     aRxFifoSize : Integer;                                     // Receiver fifo size
                     aTxFifoSize : Integer;                                     // Transmitter fifo size
                     aTimeOut    : Integer);                                    // Timeout for connections
  procedure   AfterConstruction; override;
  procedure   BeforeDestruction; override;
  destructor  Destroy; override;
 public                                                                         // General I/O:
  function    Send(const aData:LongString):LongInt;                             // Send a data to pipe
  function    Recv(aMaxLen:LongInt=MaxInt):LongString;                          // Recveive a data  from pipe
 public
  function    GetProperties:LongString;                                         // Properties
  function    Ctrl(const arg:LongString):LongString;                            // Control
  procedure   Clear(const What:LongString);                                     // Clear What: Rx/TxLost/Fifo/Total,Logs
 public
  property    HostName     : LongString    read  GetHostName;                   // Peer Host Name (client) or empty (server)
  property    BaseName     : LongString    read  GetBaseName;                   // Pipe Base Name - logical name to identify
  property    PipeName     : LongString    read  GetPipeName;                   // BaseName (server) or HostName\BaseName (client)
  property    FileName     : LongString    read  GetFileName;                   // Pipe FileName like \\.\name or /run/name.socket
  property    IsServer     : Boolean       read  GetIsServer;                   // Pipe is Server side?
  property    IsClient     : Boolean       read  GetIsClient;                   // Pipe is Client side?
  property    RxFifo       : TFifo         read  GetRxFifo;                     // Receiver FIFO
  property    TxFifo       : TFifo         read  GetTxFifo;                     // Transmitter FIFO
  property    Polling      : TPolling      read  GetPolling;                    // Polling thread
  property    Reporter     : TPipeReporter write SetReporter;                   // Error report procedure
  property    Connected    : Boolean       read  GetConnected;                  // Connected?
  property    Timeout      : Integer       read  GetTimeout;                    // Timeout to wait operations
  property    LogsText     : TText         read  GetLogsText;                   // Log events text
  property    LogsHistory  : Integer       read  GetLogsHistory;                // History for list of logs
  property    LogsCount    : Integer       read  GetLogsCount;                  // Count of logs in list.
  property    LogsTextMove : LongString    read  GetLogsTextMove;               // Get logs as text and clear
  property    LogsTextCopy : LongString    read  GetLogsTextCopy;               // Get logs as text and keep
  property    ListenPeriod : Integer       read  GetListenPeriod write SetListenPeriod; // Period to listen/accept, ms
 private
  class var TheDefDelay:Integer;
  class function  GetDefDelay:Integer; static;
  class procedure SetDefDelay(aDelay:Integer); static;
  class var TheDefTimeout:Integer;
  class function  GetDefTimeout:Integer; static;
  class procedure SetDefTimeout(aTimeout:Integer); static;
  class var TheDefListenPeriod:Integer;
  class function  GetDefListenPeriod:Integer; static;
  class procedure SetDefListenPeriod(aPeriod:Integer); static;
  class var TheDefFifoSize:Integer;
  class function  GetDefFifoSize:Integer; static;
  class procedure SetDefFifoSize(aFifoSize:Integer); static;
  class var TheDefHistory:Integer;
  class function  GetDefHistory:Integer; static;
  class procedure SetDefHistory(aHistory:Integer); static;
  class var TheDefPriority:TThreadPriority;
  class function  GetDefPriority:TThreadPriority; static;
  class procedure SetDefPriority(aPriority:TThreadPriority); static;
 public
  class function  ValidateDelay(aDelay:Integer):Integer; static;
  class function  ValidateTimeout(aTimeOut:Integer):Integer; static;
  class function  ValidateListenPeriod(aPeriod:Integer):Integer; static;
  class function  ValidateFifoSize(aFifoSize:Integer):Integer; static;
  class function  ValidateHistory(aHistory:Integer):Integer; static;
  class function  ValidatePriority(aPriority:TThreadPriority):TThreadPriority; static;
 public // Default parameters for all pipes
  class property DefDelay    : Integer read GetDefDelay    write SetDefDelay;   // Polling period, ms
  class property DefTimeout  : Integer read GetDefTimeout  write SetDefTimeOut; // Timeout for IO, ms
  class property DefListenPeriod : Integer read GetDefListenPeriod write SetDefListenPeriod;
  class property DefFifoSize : Integer read GetDefFifoSize write SetDefFifoSize;// Fifo size, bytes
  class property DefHistory  : Integer read GetDefHistory  write SetDefHistory; // Logs histiry, lines
  class property DefPriority : TThreadPriority read GetDefPriority write SetDefPriority; // Priority
 protected // Helper functions for internal use
  class procedure Note(const Msg:LongString); static; inline;
  class function  ValidHandle(fd:THandle):Boolean; static; inline;
  class procedure InvalidateHandle(var fd:THandle); static; inline;
 end;

 //
 // [Pipe]
 // PipeName = alex\test            ; Host\Name; Host=''(server); Host='.'(local client)
 // FifoSize = 16                   ; Fifo size in KB
 // PipePolling = 1, tpTimeCritical ; Polling thread
 // TimeOut = 1000                  ; Timeout to check connection
 //
function  NewPipeFromIniFile(const IniFile,Section:LongString; aReporter:TPipeReporter=nil):TPipe;
function  NewPipe(const aHost : LongString;                                     // Host(client) or empty(server)
                  const aName : LongString;                                     // Pipe name
                  aReporter   : TPipeReporter   = nil;                          // Callback to report errors
                  aDelay      : Integer         = 0;                            // Polling delay, 0=Default
                  aPriority   : TThreadPriority = DefPipePriority;              // Thread priority
                  aRxFifoSize : Integer         = 0;                            // Receiver fifo size, 0=Default
                  aTxFifoSize : Integer         = 0;                            // Transmitter fifo size, 0=Default
                  aTimeOut    : Integer         = 0                             // Timeout for connections, 0=Default
                             ): TPipe;
procedure Kill(var TheObject:TPipe); overload;

function GetFullPipeListPropertiesAsText:LongString;
function GetFullPipeListProperties(TheText:TText):TText;

function FullPipeList:TObjectStorage;

{$IFDEF UNIX}
const // Linux-specific socket ioctls
 SIOCINQ  = FIONREAD; // input  queue size
 SIOCOUTQ =	TIOCOUTQ; // output queue size (not sent + not acked)
{$ENDIF ~UNIX}

/////////////////////////////////////////////////////////////////////////////////
// EasyIPC is easy (simplified) IPC via named pipes.
//
// EasyIpc_Init(PipeName,Options) - create IPC object and return his handle or 0.
//  PipeName - Host\Name for IPC client, Name for IPC server. "." mean Localhost.
//             Name should be system-unique identifier string. Example: .\DemoIpc
//  Options  - EOL delimited text as OptionName=OptionValue, where options
//             is {TimeOut,RxBuffSize,TxBuffSize,LogsHistory}.
//
// EasyIpc_Free(ipc) - Free (delete) EasyIpc object ipc (EasyIpc_Init created).
//
// EasyIpc_Poll(ipc) - Polling I/O procedure to be called periodically by timer.
//                     This procedure is obsolete.
//
// EasyIpc_Send(ipc,TextLines)  - Send TextLines to transmitter FIFO and pipe.
//
// EasyIpc_Recv(ipc,Count)  - Receive text (upto Count byte) from receiver FIFO.
//
// EasyIpc_Ctrl(ipc,arg)  - Query or Control IPC object via command (arg).
//  Request are "Name=Value" to set or "Name" to get the value of parameter Name.
//  Name can be {Connected,IsServer,IsClient,FileName,PipeName,HostName,BaseName,
//  Handle,TimeOut,RxBuffSize,TxBuffSize,RxLost,TxLost,RxFifoLimit,TxFifoLimit,
//  RxTotal,TxTotal,RxLength,TxLength,LogsHistory}
//
/////////////////////////////////////////////////////////////////////////////////
function EasyIpc_Init(const PipeName,Options:LongString):Integer;
function EasyIpc_Ref(ipc:Integer):TPipe;
function EasyIpc_Free(ipc:Integer):Boolean;
function EasyIpc_Poll(ipc:Integer):Boolean;
function EasyIpc_Send(ipc:Integer; const TextLines:LongString):Boolean;
function EasyIpc_Recv(ipc:Integer; Count:Integer):LongString;
function EasyIpc_Ctrl(ipc:Integer; const arg:LongString):LongString;

implementation

 /////////////////////////////////////////////////////
 // Private Dictionary for fast string identification.
 /////////////////////////////////////////////////////
type
 TStringIdentifier = (
  sid_Unknown,
  ////////////////////// Properties ReadOnly
  sid_Connected,
  sid_IsServer,
  sid_IsClient,
  sid_FileName,
  sid_PipeName,
  sid_HostName,
  sid_BaseName,
  sid_Handle,
  sid_TimeOut,
  sid_RxLost,
  sid_TxLost,
  sid_RxTotal,
  sid_TxTotal,
  sid_RxLength,
  sid_TxLength,
  sid_RxFifoLimit,
  sid_TxFifoLimit,
  sid_LogsCount,
  ////////////////////// Properties Writable
  sid_LogsHistory,
  sid_RxBuffSize,
  sid_TxBuffSize,
  sid_RxPipeSize,
  sid_TxPipeSize,
  sid_Polling,
  sid_Priority,
  sid_PollingDelay,
  sid_PollingPeriod,
  sid_PollingPriority,
  sid_Listen,
  sid_ListenDelay,
  sid_ListenPeriod,
  ////////////////////// Special IO
  sid_LogsTextMove,
  sid_LogsTextCopy,
  sid_Clear,
  sid_RxRecv,
  sid_TxSend,
  ////////////////////// Properties End
  sid_Asterisk,
  sid_Question,
  sid_Unused
 );

const
 Dictionary:THashList=nil;

procedure FreeDictionary;
begin
 Kill(Dictionary);
end;

procedure InitDictionary;
 procedure AddSid(const key:LongString; sid:TStringIdentifier);
 begin
  Dictionary.KeyedLinks[key]:=Ord(sid);
 end;
begin
 if (Dictionary<>nil) then Exit;
 Dictionary:=NewHashList(false,HashList_DefaultHasher);
 Dictionary.Master:=@Dictionary;
 Dictionary.OwnsObjects:=false;
 /////////////////////////////////////////////
 // Dictionary for fast strings identification
 /////////////////////////////////////////////
 AddSid( 'Connected'           , sid_Connected);
 AddSid( 'IsServer'            , sid_IsServer);
 AddSid( 'IsClient'            , sid_IsClient);
 AddSid( 'FileName'            , sid_FileName);
 AddSid( 'PipeName'            , sid_PipeName);
 AddSid( 'HostName'            , sid_HostName);
 AddSid( 'BaseName'            , sid_BaseName);
 AddSid( 'Handle'              , sid_Handle);
 AddSid( 'TimeOut'             , sid_TimeOut);
 AddSid( 'RxLost'              , sid_RxLost);
 AddSid( 'TxLost'              , sid_TxLost);
 AddSid( 'RxTotal'             , sid_RxTotal);
 AddSid( 'TxTotal'             , sid_TxTotal);
 AddSid( 'RxLength'            , sid_RxLength);
 AddSid( 'TxLength'            , sid_TxLength);
 AddSid( 'RxFifoLimit'         , sid_RxFifoLimit);
 AddSid( 'TxFifoLimit'         , sid_TxFifoLimit);
 AddSid( 'LogsCount'           , sid_LogsCount);
 AddSid( 'LogsHistory'         , sid_LogsHistory);
 AddSid( 'RxBuffSize'          , sid_RxBuffSize);
 AddSid( 'TxBuffSize'          , sid_TxBuffSize);
 AddSid( 'RxPipeSize'          , sid_RxPipeSize);
 AddSid( 'TxPipeSize'          , sid_TxPipeSize);
 AddSid( 'Polling'             , sid_Polling);
 AddSid( 'Priority'            , sid_Priority);
 AddSid( 'PollingDelay'        , sid_PollingDelay);
 AddSid( 'PollingPeriod'       , sid_PollingPeriod);
 AddSid( 'PollingPriority'     , sid_PollingPriority);
 AddSid( 'Listen'              , sid_Listen);
 AddSid( 'ListenDelay'         , sid_ListenDelay);
 AddSid( 'ListenPeriod'        , sid_ListenPeriod);
 AddSid( 'LogsTextMove'        , sid_LogsTextMove);
 AddSid( 'LogsTextCopy'        , sid_LogsTextCopy);
 AddSid( 'Clear'               , sid_Clear);
 AddSid( 'RxRecv'              , sid_RxRecv);
 AddSid( 'TxSend'              , sid_TxSend);
 AddSid( '*'                   , sid_Asterisk);
 AddSid( '?'                   , sid_Question);
end;

function Identify(const key:LongString):TStringIdentifier;
var sid:Integer;
begin
 if (Dictionary=nil) then InitDictionary;
 sid:=Dictionary.KeyedLinks[key];
 if (sid>=Ord(Low(TStringIdentifier))) and (sid<=Ord(High(TStringIdentifier)))
 then Result:=TStringIdentifier(sid)
 else Result:=sid_Unknown;
end;

const
 sid_Ctrl_Hidden   = [sid_LogsTextMove..sid_TxSend];
 sid_Ctrl_Readable = [Succ(sid_Unknown)..Pred(sid_Asterisk)]-sid_Ctrl_Hidden;
 sid_Ctrl_Writable = [sid_LogsHistory..Pred(sid_Asterisk)]-sid_Ctrl_Hidden;

const
 dlc_NamedPipe : Integer = 0;

 {
 ********************
 TPipe implementation
 ********************
 }
procedure PipePollAction(aPolling:TPolling; var Terminate:Boolean);
var Obj:TObject;
begin
 Obj:=aPolling.LinkObject;
 if (Obj is TPipe)
 then TPipe(Obj).Poll
 else Terminate:=true;
end;

function TPipe.GetHostName:LongString;
begin
 if Assigned(Self)
 then Result:=myHostName
 else Result:='';
end;

function TPipe.GetBaseName:LongString;
begin
 if Assigned(Self)
 then Result:=myBaseName
 else Result:='';
end;

function TPipe.GetPipeName:LongString;
begin
 Result:='';
 if Assigned(Self) then begin
  if (myHostName='')
  then Result:=myBaseName
  else Result:=AddBackSlash(myHostName)+myBaseName;
 end;
end;

function TPipe.GetFileName:LongString;
begin
 if Assigned(Self)
 then Result:=myFileName
 else Result:='';
end;

function TPipe.InitFileName:LongString;
var dir:LongString;
begin
 Result:='';
 if Assigned(Self) then begin
  Result:=myBaseName;
  if IsWindows then begin
   if (myHostName='')
   then Result:=Format('\\%s\pipe\%s',['.',myBaseName])
   else Result:=Format('\\%s\pipe\%s',[myHostName,myBaseName]);
  end;
  if IsUnix then begin
   dir:=GetSpecialShellFolderPath(CSIDL_XDG_RUNTIME_DIR,'namedpipes');
   if not DirExists(dir) then MkDir(Dir);
   if not DirExists(dir) then dir:=GlobalTempDir;
   Result:=AddPathDelim(dir)+myBaseName+'.socket';
  end;
 end;
end;

function TPipe.GetIsServer:Boolean;
begin
 if Assigned(Self)
 then Result:=(myHostName='')
 else Result:=false;
end;

function TPipe.GetIsClient:Boolean;
begin
 if Assigned(Self)
 then Result:=(myHostName<>'')
 else Result:=false;
end;

function TPipe.GetRxFifo:TFifo;
begin
 if Assigned(Self)
 then Result:=myRxFifo
 else Result:=nil;
end;

function TPipe.GetTxFifo:TFifo;
begin
 if Assigned(Self)
 then Result:=myTxFifo
 else Result:=nil;
end;

function TPipe.GetPolling:TPolling;
begin
 if Assigned(Self)
 then Result:=myPolling
 else Result:=nil;
end;

function TPipe.GetConnected:Boolean;
begin
 if Assigned(Self)
 then Result:=myConnected
 else Result:=false;
end;

function TPipe.GetTimeout:Integer;
begin
 if Assigned(Self)
 then Result:=myTimeout
 else Result:=0;
end;

function TPipe.GetHandle(i:Integer=0):THandle;
begin
 Result:=0;
 if Assigned(Self) then begin
  {$IFDEF WINDOWS}
  Result:=myFile;
  {$ENDIF ~WINDOWS}
  {$IFDEF UNIX}
  case i of
   0: Result:=mySock;
   1: Result:=myConn;
  end;
  {$ENDIF ~UNIX}
 end;
end;

function TPipe.GetLogsText:TText;
begin
 if Assigned(Self)
 then Result:=myLogsText
 else Result:=nil;
end;

function TPipe.GetLogsHistory:Integer;
begin
 if Assigned(Self)
 then Result:=myLogsHistory
 else Result:=0;
end;

function TPipe.GetLogsCount:Integer;
begin
 if Assigned(Self)
 then Result:=myLogsText.Count
 else Result:=0;
end;

function TPipe.GetLogsTextMove:LongString;
begin
 if Assigned(Self)
 then begin Result:=myLogsText.Text; myLogsText.Count:=0; end
 else Result:='';
end;

function TPipe.GetLogsTextCopy:LongString;
begin
 if Assigned(Self)
 then Result:=myLogsText.Text
 else Result:='';
end;

function TPipe.GetListenPeriod:Integer;
begin
 if Assigned(Self)
 then Result:=myListenPeriod
 else Result:=0;
end;

procedure TPipe.SetListenPeriod(aPeriod:Integer);
begin
 if Assigned(Self)
 then myListenPeriod:=IfThen(aPeriod>0,aPeriod,DefListenPeriod);
end;

procedure TPipe.Report(const What:LongString; Code:Integer);
var Line:LongString; When:Double;
begin
 if Assigned(Self) then
 try
  if DebugLogEnabled(dlc_NamedPipe) then begin
   Line:=PipeName+': '+What+', '+SysErrorMessage(Code);
   DebugLog(dlc_NamedPipe,Line);
  end;
  When:=msecnow;
  if Assigned(myReporter) then begin
   myReporter(Self,When,What,Code);
   Exit;
  end;
  if (LogsHistory>0) then begin
   Line:=StdDateTimeStr(When,nttsm_DateTimeZzz)+' => '
        +PipeName+': '+What+', '+SysErrorMessage(Code);
   LogsText.AddLn(Line);
  end;
  while (LogsText.Count>LogsHistory) do LogsText.DelLn(0);
 except
  on E:Exception do BugReport(E,Self,'Report');
 end;
end;

procedure TPipe.SetReporter(aReporter:TPipeReporter);
begin
 if Assigned(Self) then myReporter:=aReporter;
end;

function TPipe.Send(const aData:LongString):LongInt;
begin
 if Assigned(Self) and (aData<>'')
 then Result:=Ord(myTxFifo.PutText(aData))*Length(aData)
 else Result:=0;
end;

function TPipe.Recv(aMaxLen:LongInt=MaxInt):LongString;
begin
 if Assigned(Self) and (aMaxLen>0)
 then Result:=myRxFifo.GetText(aMaxLen)
 else Result:='';
end;

procedure TPipe.Close(aErrorCode:Integer; aRxLost:Integer; aTxLost:Integer);
begin
 if Assigned(Self) then
 try
  {$IFDEF WINDOWS}
  if ValidHandle(myFile) then begin                                            // If file opened
   CloseHandle(myFile);                                                        // Close file
   InvalidateHandle(myFile);                                                   // Mark it closed
   myConnected:=false;                                                         // No connection
   myRxPending:=false;                                                         // No pending read
   myTxPending:=false;                                                         // No pending write
   SafeFillChar(myRxOverlap,sizeof(myRxOverlap),0);                            // Clear read overlap
   SafeFillChar(myTxOverlap,sizeof(myTxOverlap),0);                            // Clear write overlap
  end;
  {$ENDIF ~WINDOWS}
  {$IFDEF UNIX}
  if ValidHandle(myConn) then begin                                            // Server connection opened?
   FpShutdown(myConn,SHUT_RDWR);                                               // Shutdown connection
   FpClose(myConn);                                                            // Close connection
   InvalidateHandle(myConn);                                                   // Mark it closed
  end;
  if ValidHandle(mySock) then begin                                            // If socket opened
   FpShutdown(mySock,SHUT_RDWR);                                               // Shutdown connection
   FpClose(mySock);                                                            // Close socket
   if IsServer then FpUnlink(FileName);                                        // Unlink socket file
   InvalidateHandle(mySock);                                                   // Mark it closed
  end;
  myConnected:=false;                                                          // No connection
  Inc(aRxLost,Length(myRxBuff));                                               // This Rx data lost
  Inc(aTxLost,Length(myTxBuff));                                               // This Tx data lost
  myRxBuff:='';                                                                // Clear Rx Buffer
  myTxBuff:='';                                                                // Clear Tx Buffer
  {$ENDIF ~UNIX}
  if (aErrorCode<>ERROR_SUCCESS) or (aRxLost+aTxLost<>0) then begin            // If error occured
   myRxFifo.Lost:=myRxFifo.Lost+Length(myRxFifo.GetText)+aRxLost;              // Receiver data lost
   myTxFifo.Lost:=myTxFifo.Lost+Length(myTxFifo.GetText)+aTxLost;              // Transmitter data lost
  end;
  Report('Close',aErrorCode);
 except
  on E:Exception do BugReport(E,Self,'Close');
 end;
end;

constructor TPipe.Create(const aHost : LongString;
                         const aName : LongString;
                         aReporter   : TPipeReporter;
                         aDelay      : Integer;
                         aPriority   : TThreadPriority;
                         aRxFifoSize : Integer;
                         aTxFifoSize : Integer;
                         aTimeOut    : Integer);
begin
 inherited Create;
 myHostName:=Trim(LowerCase(aHost));
 myBaseName:=Trim(LowerCase(aName));
 myFileName:=InitFileName;
 {$IFDEF WINDOWS}
 InvalidateHandle(myFile);
 myRxPending:=false;
 myTxPending:=false;
 SafeFillChar(myRxOverlap,sizeof(myRxOverlap),0);
 SafeFillChar(myTxOverlap,sizeof(myTxOverlap),0);
 SafeFillChar(myRxBuffer,sizeof(myRxBuffer),0);
 SafeFillChar(myTxBuffer,sizeof(myTxBuffer),0);
 if InitializeSecurityDescriptor(@mySecDesc,SECURITY_DESCRIPTOR_REVISION) and
    SetSecurityDescriptorDacl(@mySecDesc,True,nil,True)
 then Report('InitializeSecurity',ERROR_SUCCESS)
 else Report('InitializeSecurity',GetLastError);
 mySecAttr.nLength:=sizeof(mySecAttr);
 mySecAttr.lpSecurityDescriptor:=@mySecDesc;
 mySecAttr.bInheritHandle:=False;
 {$ENDIF ~WINDOWS}
 {$IFDEF UNIX}
 InvalidateHandle(mySock);
 InvalidateHandle(myConn);
 myRxBuff:='';
 myTxBuff:='';
 {$ENDIF ~UNIX}
 aDelay:=ValidateDelay(aDelay);
 aTimeOut:=ValidateTimeout(aTimeOut);
 aPriority:=ValidatePriority(aPriority);
 aRxFifoSize:=ValidateFifoSize(aRxFifoSize);
 aTxFifoSize:=ValidateFifoSize(aTxFifoSize);
 myRxFifo:=NewFifo(aRxFifoSize);
 myRxFifo.Master:=@myRxFifo;
 myRxFifo.GrowFactor:=DefPipeFactor;
 myTxFifo:=NewFifo(aTxFifoSize);
 myTxFifo.Master:=@myTxFifo;
 myTxFifo.GrowFactor:=DefPipeFactor;
 myPolling:=NewPolling(PipePollAction,aDelay,aPriority,false,PipeName);
 myPolling.Master:=@myPolling;
 myPolling.LinkObject:=Self;
 myReporter:=aReporter;
 myConnected:=false;
 myTimeOut:=aTimeOut;
 myRxLost:=0;
 myTxLost:=0;
 myLastTick:=0;
 myLastCheck:=0;
 myLogsHistory:=DefHistory;
 myLogsText:=NewText(DefHistory);
 myLogsText.Master:=@myLogsText;
 myListenPeriod:=DefListenPeriod;
end;

procedure TPipe.AfterConstruction;
begin
 inherited AfterConstruction;
 FullPipeList.Add(Self);
 Polling.Enable(true);
end;

procedure TPipe.BeforeDestruction;
begin
 Polling.Enable(false);
 FullPipeList.Remove(Self);
 inherited BeforeDestruction;
end;

destructor TPipe.Destroy;
begin
 try
  Polling.Enable(false);
  Close;
  myHostName:='';
  myBaseName:='';
  myFileName:='';
  Kill(myPolling);
  Kill(myRxFifo);
  Kill(myTxFifo);
  Kill(myLogsText);
 except
  on E:Exception do BugReport(E,Self,'Destroy');
 end;
 inherited Destroy;
end;

function TPipe.GetProperties:LongString;
const PropList='HostName,BaseName,PipeName,FileName,IsServer,IsClient,'
              +'Polling,Priority,TimeOut,ListenPeriod,RxPipeSize,TxPipeSize,'
              +'RxTotal,TxTotal,RxLost,TxLost';
var Lines:TText; i:Integer; id:LongString;
begin
 Result:='';
 if Assigned(Self) then
 try
  Lines:=NewText;
  try
   for i:=1 to WordCount(PropList,ScanSpaces) do begin
    id:=ExtractWord(i,PropList,ScanSpaces);
    Lines.AddLn(id+' = '+Ctrl(id));
   end;
   Result:=Lines.Text;
  finally
   Kill(Lines);
  end;
 except
  on E:Exception do BugReport(E,Self,'GetProperties');
 end;
end;

{$IFDEF WINDOWS}
procedure TPipe.Poll;
var
 RxCount : DWORD;
 TxCount : DWORD;
begin
 if Assigned(Self) then
 try
  //
  // If file handle is not created, try to create it
  //
  if not ValidHandle(myFile) then begin                                        // If file not opened
   if IsServer then begin                                                      // Server:
    myFile:=CreateNamedPipe(PChar(FileName),                                   // pointer to file name
                            PIPE_ACCESS_DUPLEX or FILE_FLAG_OVERLAPPED,        // pipe open mode
                            PIPE_TYPE_BYTE or PIPE_READMODE_BYTE,              // pipe-specific modes
                            1,                                                 // maximum number of instances
                            TxFifo.Size,                                       // output buffer size, in bytes
                            RxFifo.Size,                                       // input buffer size, in bytes
                            TimeOut,                                           // time-out time, msec
                            @mySecAttr);                                       // pointer to security attributes structure
    if ValidHandle(myFile)                                                     // If file created
    then Report('CreateNamedPipe',ERROR_SUCCESS)                               // Then report success
    else Report('CreateNamedPipe',GetLastError);                               // Else report error
   end else begin                                                              // Client:
    myFile:=CreateFile(PChar(FileName),                                        // pointer to name of the file
                       GENERIC_READ or GENERIC_WRITE,                          // access mode
                       FILE_SHARE_READ or FILE_SHARE_WRITE,                    // share mode
                       @mySecAttr,                                             // security
                       OPEN_EXISTING,                                          // how to create
                       FILE_FLAG_OVERLAPPED,                                   // use overlapped I/O
                       0);                                                     // template file - not used
    if ValidHandle(myFile)                                                     // If file created
    then Report('CreateFile',ERROR_SUCCESS)                                    // Report success
    else Report('CreateFile',GetLastError);                                    // Else report error
   end;
   if ValidHandle(myFile) then begin                                           // If file was created
    myConnected:=false;                                                        // Mark no connection
    myRxPending:=false;                                                        // Mark no pending read
    myTxPending:=false;                                                        // Mark no pending write
    SafeFillChar(myRxOverlap,sizeof(myRxOverlap),0);                           // Clear read overlap
    SafeFillChar(myTxOverlap,sizeof(myTxOverlap),0);                           // Clear write overlap
   end else Sleep(TimeOut);                                                    // If file fails,wait some time
  end;
  //
  // File created, may connect/read/write
  //
  if ValidHandle(myFile) then begin
   //
   // If not still connected, try to connect now...
   //
   RxCount:=0;
   if not myConnected then begin
    while ReadFile(myFile,myRxBuffer,sizeof(myRxBuffer),RxCount,@myRxOverlap)  // Read data to buffer
    do myRxFifo.Put(@myRxBuffer,RxCount);                                      // Transfer to FIFO
    case GetLastError of                                                       // Analize error:
     ERROR_PIPE_LISTENING:;                                                    // Server waiting for client
     ERROR_IO_PENDING:                                                         // Connection established
      begin
       myConnected:=true;                                                      // Mark we are connected
       myRxPending:=true;                                                      // Mark pending read
       Report('Connected',ERROR_SUCCESS);                                      // Mark connection
      end;
     ERROR_HANDLE_EOF: Close(GetLastError,RxCount);                            // End of file reached
     ERROR_BROKEN_PIPE: Close(GetLastError,RxCount);                           // Connection lost
     else Close(GetLastError,RxCount);                                         // Unknown error occured
    end;
   end;
   //
   // If connection esteblished, try to read from pipe...
   //
   if myConnected then begin                                                   // When connected
    if myRxPending then begin                                                  // When pending read:
     if GetOverlappedResult(myFile,myRxOverlap,RxCount,FALSE) then begin       // If pending read complete
      myRxFifo.Put(@myRxBuffer,RxCount);                                       // Put data to FIFO
      myRxPending:=false;                                                      // Clear pending flag
     end else                                                                  // Else
     case GetLastError of                                                      // Analize errors:
      ERROR_IO_INCOMPLETE: ;                                                   // Wait for read completion
      ERROR_HANDLE_EOF: Close(GetLastError,RxCount);                           // End of file reached
      ERROR_BROKEN_PIPE: Close(GetLastError,RxCount);                          // Connection lost
      else Close(GetLastError,RxCount);                                        // Unknown error occured
     end;
    end else begin                                                             // When no pending read:
     RxCount:=min(sizeof(myRxBuffer),myRxFifo.Space);                          // Check FIFO space
     if RxCount>0 then begin                                                   // If have FIFO space
      if ReadFile(myFile,myRxBuffer,RxCount,RxCount,@myRxOverlap)              // If read immediatly
      then myRxFifo.Put(@myRxBuffer,RxCount)                                   // Then put data to FIFO
      else                                                                     // If not read
      case GetLastError of                                                     // Analize error:
       ERROR_IO_PENDING: myRxPending:=true;                                    // Mark pending read
       ERROR_HANDLE_EOF: Close(GetLastError,RxCount);                          // End of file reached
       ERROR_BROKEN_PIPE: Close(GetLastError,RxCount);                         // Connection lost
       else Close(GetLastError,RxCount);                                       // Unknown error occured
      end;
     end;
    end;
   end;
   //
   // If connection esteblished, try to write to pipe...
   //
   TxCount:=0;
   if myConnected then begin                                                   // When connected
    if myTxPending then begin                                                  // When pending write:
     if GetOverlappedResult(myFile,myTxOverlap,TxCount,FALSE)                  // If write complete
     then myTxPending:=false                                                   // Clear pending flag
     else                                                                      // If not write complete
     case GetLastError of                                                      // Analize error:
      ERROR_IO_INCOMPLETE: ;                                                   // Wait for write completion
      ERROR_BROKEN_PIPE: Close(GetLastError,0,TxCount);                        // Connection lost
      else Close(GetLastError,0,TxCount);                                      // Unknown error occured
     end;
    end else begin                                                             // When no pending write:
     TxCount:=myTxFifo.Get(@myTxBuffer,sizeof(myTxBuffer));                    // Copy FIFO to buffer
     if TxCount>0 then begin                                                   // If has data to write
      if not WriteFile(myFile,myTxBuffer,TxCount,TxCount,@myTxOverlap) then    // If not written immediatly
      case GetLastError of                                                     // Analize error:
       ERROR_IO_PENDING: myTxPending:=true;                                    // Mark pending write
       ERROR_BROKEN_PIPE: Close(GetLastError,0,TxCount);                       // Connection lost
       else Close(GetLastError,0,TxCount);                                     // Unknown error occured
      end;
     end;
    end;
   end;
  end;
  //
  // Check if FIFO data lost, report if so
  //
  if (GetTickCount64>myLastCheck+TimeOut) then begin                           // Every TimeOut milliseconds
   if myRxFifo.Lost<>myRxLost then begin                                       // Check if RxFifo.Lost changed
    if myRxFifo.Lost>myRxLost then Report('RxLost',-1);                        // If increased, report Rx data lost
    myRxLost:=myRxFifo.Lost;                                                   // Remember for future
   end;
   if myTxFifo.Lost<>myTxLost then begin                                       // Check if TxFifo.Lost changed
    if myTxFifo.Lost>myTxLost then Report('TxLost',-1);                        // If increased, report Tx data lost
    myTxLost:=myTxFifo.Lost;                                                   // Remember for future
   end;
   myLastCheck:=GetTickCount64;                                                // Remember moment of last check
  end;
 except
  on E:Exception do BugReport(E,Self,'Poll');
 end;
end;
{$ENDIF ~WINDOWS}

{$IFDEF UNIX}
procedure TPipe.Poll;
var address:sockaddr_un; ListenTick:Boolean; FakeConn:THandle;
 // Get number of bytes available to read
 function GetRxAvail(fd:THandle):LongInt;
 begin
  Result:=0;
  if (FpIoctl(fd,FIONREAD,@Result)<0) then Result:=-1;
 end;
 // Increment FIFO data lost counter
 procedure FifoDataLost(Fifo:TFifo; Num:Integer); inline;
 begin
  Fifo.Lost:=Fifo.Lost+Num;
 end;
 // Receive data from (nonblock) socket and write to FIFO
 procedure DoReceive(RxSock:THandle; RxFifo:TFifo; var RxBuff:LongString);
 var Num,Len:Integer; Buff:LongString;
 begin
  if ValidHandle(RxSock) then begin
   RxBuff:='';
   Num:=GetRxAvail(RxSock);
   while (Num>0) do begin
    Buff:=StringBuffer(Num);
    Len:=FpRecv(RxSock,PChar(Buff),Length(Buff),MSG_DONTWAIT);
    if (Len<0) then begin
     if not ePendingFileOperation(GetLastOsError) then begin
      Report('FpRecv',GetLastOsError);
      FifoDataLost(RxFifo,Num);
      Close(GetLastOsError);
     end;
     Break;
    end;
    if (Len<Length(Buff)) then SetLength(Buff,Len);
    if (Buff='') then Break else RxBuff:=RxBuff+Buff;
    Num:=GetRxAvail(RxSock);
   end;
   if (Num<0) then begin
    if not ePendingFileOperation(GetLastOsError) then begin
     Report('FpIoctl',GetLastOsError);
     Close(GetLastOsError);
     Exit;
    end;
   end;
   if (RxBuff<>'') then RxFifo.PutText(RxBuff);
   RxBuff:='';
  end;
 end;
 procedure DoTransmit(TxSock:THandle; TxFifo:TFifo; var TxBuff:LongString);
 var Num,Len:Integer; Deadline:QWord; Partial,HasData,HasTime,DropTail:Boolean;
 begin
  if ValidHandle(TxSock) then begin
   if (TxBuff='') then TxBuff:=TxFifo.GetText;
   if (TxBuff<>'') then begin
    Deadline:=GetTickCount64+Timeout;
    while (TxBuff<>'') do begin
     Num:=Length(TxBuff);
     Num:=Min(Num,OS_PIPE_BUF);
     Partial:=(Num<Length(TxBuff));
     Len:=FpSend(TxSock,PChar(TxBuff),Num,MSG_NOSIGNAL or MSG_DONTWAIT);
     case Sign(Len) of
      0:  begin
           Report('FpSend',GetLastOsError);
           Close(GetLastOsError);
           Break;
          end;
      +1: Delete(TxBuff,1,Len);
      -1: if ePendingFileOperation(GetLastOsError)
          then Partial:=true
          else begin
           Report('FpSend',GetLastOsError);
           Close(GetLastOsError);
           Break;
          end;
     end;
     HasData:=(TxBuff<>'');
     if not HasData then Break;
     HasTime:=(GetTickCount64<Deadline);
     if HasData and Partial and HasTime
     then Sleep(Polling.Delay)
     else Break;
    end;
    DropTail:=true;
    // If we still has unwritten data, it will be lost.
    if (TxBuff<>'') and DropTail then begin
     FifoDataLost(TxFifo,Length(TxBuff));
     TxBuff:='';
    end;
   end;
  end;
 end;
 // Check connection status by sending zero data.
 procedure CheckConnectionStatus(Sock:THandle);
 const Tmp:Integer=0;
 begin
  if ValidHandle(Sock) then begin
   if (FpSend(Sock,@Tmp,0,MSG_NOSIGNAL or MSG_DONTWAIT)<0) then begin
    if not ePendingFileOperation(GetLastOsError) then begin
     Report('FpSend',GetLastOsError);
     Close(GetLastOsError);
    end;
   end;
  end;
 end;
 // Fill unix socket address struct
 procedure UnixSockAddress(out address:sockaddr_un; aName:LongString);
 begin
  address.sun_family:=AF_UNIX;
  StrLCopy(address.sun_path,PChar(aName),SizeOf(address.sun_path)-1);
 end;
begin
 if Assigned(Self) then
 try
  // Every ListenPeriod tick …
  ListenTick:=(GetTickCount64>=myLastTick+myListenPeriod);
  if ListenTick then myLastTick:=GetTickCount64;
  //
  // Try create socket if not created yet.
  //
  if ListenTick then
  if not ValidHandle(mySock) then begin
   // Create Unix domain socket.
   UnixSockAddress(address,FileName);
   if IsServer then begin
    // Create socket.
    mySock:=FpSocket(AF_UNIX,SOCK_STREAM,0);
    if ValidHandle(mySock)
    then Report('FpSocket',ERROR_SUCCESS) else begin
     Report('FpSocket',GetLastOsError);
     Close(GetLastOsError);
     Exit;
    end;
    {$IFDEF UNIX}
    // Set close-on-exec flag.
    if FileSetCloseOnExec(mySock,true)
    then Report('FileSetCloseOnExec',ERROR_SUCCESS)
    else Report('FileSetCloseOnExec',GetLastOsError);
    {$ENDIF ~UNIX}
    // Make socket nonblock.
    if FileSetNonBlockFlag(mySock,true)
    then Report('FileSetNonBlockFlag',ERROR_SUCCESS)
    else Report('FileSetNonBlockFlag',GetLastOsError);
    // Bind the socket to the address.
    if(FpBind(mySock,@address,SizeOf(address))=0)
    then Report('FpBind',ERROR_SUCCESS) else begin
     Report('FpBind',GetLastOsError);
     Close(GetLastOsError);
     Exit;
    end;
    // Listen up to N=1 connections.
    if(FpListen(mySock,1)=0)
    then Report('FpListen',ERROR_SUCCESS) else begin
     Report('FpListen',GetLastOsError);
     Close(GetLastOsError);
     Exit;
    end;
   end else begin
     // Create socket.
     mySock:=FpSocket(AF_UNIX,SOCK_STREAM,0);
     if ValidHandle(mySock)
     then Report('FpSocket',ERROR_SUCCESS) else begin
      Report('FpSocket',GetLastOsError);
      Close(GetLastOsError);
      Exit;
     end;
     {$IFDEF UNIX}
     // Set close-on-exec flag.
     if FileSetCloseOnExec(mySock,true)
     then Report('FileSetCloseOnExec',ERROR_SUCCESS)
     else Report('FileSetCloseOnExec',GetLastOsError);
     {$ENDIF ~UNIX}
     // Make socket nonblock.
     if FileSetNonBlockFlag(mySock,true)
     then Report('FileSetNonBlockFlag',ERROR_SUCCESS)
     else Report('FileSetNonBlockFlag',GetLastOsError);
   end;
  end;
  //
  // If socket opened, make I/O.
  //
  if ValidHandle(mySock) then begin
   if IsServer then begin
    if ValidHandle(myConn) then begin
     if ListenTick then begin
      // Fake Accept for excessive incoming connections.
      FakeConn:=FpAccept(mySock,nil,nil);
      if ValidHandle(FakeConn) then begin
       Report('FakeFpAccept',ERROR_SUCCESS);
       FpShutdown(FakeConn,SHUT_RDWR);
       FpClose(FakeConn);
      end else begin
       if ePendingFileOperation(GetLastOsError)
       then Note('Wait connection') else begin
        Report('FakeFpAccept',GetLastOsError);
       end;
      end;
     end;
    end else begin
     // Accept incoming connections.
     myConn:=FpAccept(mySock,nil,nil);
     if ValidHandle(myConn) then begin
      Report('FpAccept',ERROR_SUCCESS);
      Note('Server:Connected');
      myConnected:=true;
      // Make it nonblock.
      if FileSetNonBlockFlag(myConn,true)
      then Report('FileSetNonBlockFlag',ERROR_SUCCESS)
      else Report('FileSetNonBlockFlag',GetLastOsError);
     end else begin
      if ePendingFileOperation(GetLastOsError)
      then Note('Wait connection') else begin
       Report('FpAccept',GetLastOsError);
       Close(GetLastOsError);
      end;
     end;
    end;
   end else begin
    if Connected then begin
     // Client make I/O.
     DoReceive(mySock,myRxFifo,myRxBuff);
     DoTransmit(mySock,myTxFifo,myTxBuff);
     if ListenTick then CheckConnectionStatus(mySock);
    end else begin
     // Connect Unix domain socket.
     UnixSockAddress(address,FileName);
     // Connect to the server.
     if (FpConnect(mySock,@address,SizeOf(sockaddr_un))=0) then begin
      Report('FpConnect',ERROR_SUCCESS);
      myConnected:=true;
     end else begin
      if ePendingFileOperation(GetLastOsError)
      then Note('Wait connection') else begin
       Report('FpAccept',GetLastOsError);
       Close(GetLastOsError);
      end;
     end;
    end;
   end;
  end;
  //
  // If server connected…
  //
  if IsServer then
  if Connected then
  if ValidHandle(myConn) then begin
   // Apply server Rx/Tx operations.
   DoReceive(myConn,myRxFifo,myRxBuff);
   DoTransmit(myConn,myTxFifo,myTxBuff);
   if ListenTick then CheckConnectionStatus(myConn);
  end;
 except
  on E:Exception do BugReport(E,Self,'Poll');
 end;
end;
{$ENDIF ~UNIX}

function TPipe.Ctrl(const arg:LongString):LongString;
var p,i,si,iv:Integer; sn,sv,par:LongString;
begin
 Result:='';
 if Assigned(Self) then
 try
  Result:='?'; sn:=''; sv:='';
  p:=ExtractNameValuePair(arg,sn,sv,'=',1);
  case Identify(sn) of
   sid_Connected:   Result:=IntToStr(Ord(Connected));
   sid_IsServer:    Result:=IntToStr(Ord(IsServer));
   sid_IsClient:    Result:=IntToStr(Ord(IsClient));
   sid_FileName:    Result:=FileName;
   sid_PipeName:    Result:=PipeName;
   sid_HostName:    Result:=HostName;
   sid_BaseName:    Result:=BaseName;
   sid_Handle:      Result:=IntToStr(GetHandle(StrToIntDef(Trim(sv),0)));
   sid_TimeOut:     Result:=IntToStr(TimeOut);
   sid_RxLost:      Result:=IntToStr(RxFifo.Lost);
   sid_TxLost:      Result:=IntToStr(TxFifo.Lost);
   sid_RxTotal:     Result:=IntToStr(RxFifo.Total);
   sid_TxTotal:     Result:=IntToStr(TxFifo.Total);
   sid_RxLength:    Result:=IntToStr(RxFifo.Count);
   sid_TxLength:    Result:=IntToStr(TxFifo.Count);
   sid_RxFifoLimit: Result:=IntToStr(RxFifo.GrowLimit);
   sid_TxFifoLimit: Result:=IntToStr(TxFifo.GrowLimit);
   sid_LogsHistory: begin
    if IsNonEmptyStr(sv) then myLogsHistory:=StrToIntDef(Trim(sv),LogsHistory);
    Result:=IntToStr(LogsHistory);
   end;
   sid_RxBuffSize,
   sid_RxPipeSize:  begin
    if (p>0) and TryStrToInt(Trim(sv),iv) then RxFifo.Size:=ValidateFifoSize(iv);
    Result:=IntToStr(RxFifo.Size);
   end;
   sid_TxBuffSize,
   sid_TxPipeSize:  begin
    if (p>0) and TryStrToInt(Trim(sv),iv) then TxFifo.Size:=ValidateFifoSize(iv);
    Result:=IntToStr(TxFifo.Size);
   end;
   sid_Polling,
   sid_PollingDelay,
   sid_PollingPeriod: begin
    if (p>0) and TryStrToInt(Trim(sv),iv) then Polling.Delay:=ValidateDelay(iv);
    Result:=IntToStr(Polling.Delay);
   end;
   sid_Listen,
   sid_ListenDelay,
   sid_ListenPeriod: begin
    if (p>0) and TryStrToInt(Trim(sv),iv) then ListenPeriod:=iv;
    Result:=IntToStr(ListenPeriod);
   end;
   sid_Priority,
   sid_PollingPriority: begin
    if (p>0) and IsNonEmptyStr(sv) then Polling.Priority:=ValidatePriority(StringToThreadPriority(Trim(sv),DefPriority));
    Result:=ThreadPriorityToString(Polling.Priority);
   end;
   sid_LogsCount:    Result:=IntToStr(LogsCount);
   sid_LogsTextMove: Result:=LogsTextMove;
   sid_LogsTextCopy: Result:=LogsTextCopy;
   sid_Clear:        begin
    if IsNonEmptyStr(sv) then Clear(Trim(sv));
    Result:='';
   end;
   sid_TxSend: begin
    if (p>0) then iv:=Send(sv) else iv:=0;
    Result:=IntToStr(iv);
   end;
   sid_RxRecv: begin
    iv:=MaxInt;
    if (p>0) then iv:=StrToIntDef(Trim(sv),iv);
    Result:=Recv(iv);
   end;
   sid_Asterisk,
   sid_Question: begin
    Result:='';
    if Assigned(Dictionary) then
    for i:=0 to Dictionary.Count-1 do begin
     si:=Dictionary.Links[i];
     if (si<=Ord(sid_Unknown)) then continue;
     if (si>=Ord(sid_Asterisk)) then continue;
     if not (TStringIdentifier(si) in sid_Ctrl_Readable) then continue;
     if (p>0) and not (TStringIdentifier(si) in sid_Ctrl_Writable) then continue;
     par:=Dictionary.Keys[i];
     if (sn='*') then Result:=Result+par+EOL;
     if (sn='?') then Result:=Result+par+'='+ctrl(par)+EOL;
    end;
   end;
  end;
  sn:=''; sv:='';
 except
  on E:Exception do ErrorFound(E,'Ctrl');
 end;
end;

procedure TPipe.Clear(const What:LongString);
begin
 if Assigned(Self) then begin
  if (WordIndex('RxLost',What,ScanSpaces)>0) then RxFifo.Lost:=0;
  if (WordIndex('TxLost',What,ScanSpaces)>0) then TxFifo.Lost:=0;
  if (WordIndex('RxFifo',What,ScanSpaces)>0) then RxFifo.Clear;
  if (WordIndex('TxFifo',What,ScanSpaces)>0) then TxFifo.Clear;
  if (WordIndex('RxTotal',What,ScanSpaces)>0) then RxFifo.Total:=0;
  if (WordIndex('TxTotal',What,ScanSpaces)>0) then TxFifo.Total:=0;
  if (WordIndex('Logs',What,ScanSpaces)>0) then LogsText.Count:=0;
 end;
end;

class procedure TPipe.Note(const Msg:LongString);
begin
end;

class function TPipe.ValidHandle(fd:THandle):Boolean;
begin
 Result:=(fd<>INVALID_HANDLE_VALUE);
end;

class procedure TPipe.InvalidateHandle(var fd:THandle);
begin
 fd:=INVALID_HANDLE_VALUE;
end;

class function TPipe.ValidateDelay(aDelay:Integer):Integer;
begin
 if (aDelay<=0) then aDelay:=DefDelay;
 aDelay:=EnsureRange(aDelay,1,100);
 Result:=aDelay;
end;

class function TPipe.GetDefDelay:Integer;
begin
 Result:=TheDefDelay;
end;

class procedure TPipe.SetDefDelay(aDelay:Integer);
begin
 TheDefDelay:=ValidateDelay(aDelay);
end;

class function TPipe.ValidateTimeout(aTimeOut:Integer):Integer;
begin
 if (aTimeOut<=0) then aTimeout:=DefTimeout;
 aTimeout:=EnsureRange(aTimeOut,(1000 div 5),(1000*5));
 Result:=aTimeOut;
end;

class function TPipe.GetDefTimeout:Integer;
begin
 Result:=TheDefTimeout;
end;

class procedure TPipe.SetDefTimeout(aTimeout:Integer);
begin
 TheDefTimeout:=ValidateTimeout(aTimeOut);
end;

class function TPipe.ValidateListenPeriod(aPeriod:Integer):Integer;
begin
 if (aPeriod<=0) then aPeriod:=DefListenPeriod;
 aPeriod:=EnsureRange(aPeriod,1,5000);
 Result:=aPeriod;
end;

class function TPipe.GetDefListenPeriod:Integer;
begin
 Result:=TheDefListenPeriod;
end;

class procedure TPipe.SetDefListenPeriod(aPeriod:Integer);
begin
 TheDefListenPeriod:=ValidateListenPeriod(aPeriod);
end;

class function TPipe.ValidateFifoSize(aFifoSize:Integer):Integer;
begin
 if (aFifoSize<=0) then aFifoSize:=DefFifoSize;
 aFifoSize:=EnsureRange(aFifoSize,KiloByte*4,MegaByte*4);
 Result:=aFifoSize;
end;

class function TPipe.GetDefFifoSize:Integer;
begin
 Result:=TheDefFifoSize;
end;

class procedure TPipe.SetDefFifoSize(aFifoSize:Integer);
begin
 TheDefFifoSize:=ValidateFifoSize(aFifoSize);
end;

class function TPipe.ValidateHistory(aHistory:Integer):Integer;
begin
 if (aHistory<=0) then aHistory:=DefHistory;
 aHistory:=EnsureRange(aHistory,0,1000*100);
 Result:=aHistory;
end;

class function TPipe.GetDefHistory:Integer;
begin
 Result:=TheDefHistory;
end;

class procedure TPipe.SetDefHistory(aHistory:Integer);
begin
 TheDefHistory:=ValidateHistory(aHistory);
end;

class function TPipe.GetDefPriority:TThreadPriority;
begin
 Result:=TheDefPriority;
end;

class procedure TPipe.SetDefPriority(aPriority:TThreadPriority);
begin
 TheDefPriority:=ValidatePriority(aPriority);
end;

class function TPipe.ValidatePriority(aPriority:TThreadPriority):TThreadPriority;
begin
 Result:=aPriority;
end;

function  NewPipeFromIniFile(const IniFile,Section:LongString; aReporter:TPipeReporter=nil):TPipe;
var aHost,aName:LongString; aDelay,aFifoSize,aTimeOut,aListen:Integer; aPriority:TThreadPriority;
begin
 Result:=nil;
 try
  aName:=''; aFifoSize:=0; aDelay:=0; aTimeout:=0; aListen:=0; aPriority:=tpNormal;
  if ReadIniFileAlpha(IniFile,Section,'PipeName%a',aName) then begin
   aName:=LoCaseStr(aName);
   aHost:=ExtractWord(1,aName,['\','/']);
   aName:=ExtractWord(2,aName,['\','/']);
   if IsEmptyStr(aName) then begin
    aName:=aHost;
    aHost:='';
   end;
  end else aName:='';
  if IsNonEmptyStr(aName) then begin
   if not ReadIniFileInteger(IniFile,Section,'TimeOut%i',aTimeOut) then aTimeOut:=TPipe.DefTimeOut;
   if not ReadIniFileInteger(IniFile,Section,'ListenPeriod%i',aListen) then aListen:=TPipe.DefListenPeriod;
   if not ReadIniFileInteger(IniFile,Section,'FifoSize%i',aFifoSize) then aFifoSize:=TPipe.DefFifoSize div KiloByte;
   if not ReadIniFilePolling(IniFile,Section,'PipePolling',aDelay,aPriority) then begin
    aDelay:=TPipe.DefDelay;
    aPriority:=TPipe.DefPriority;
   end;
   aTimeOut:=TPipe.ValidateTimeout(aTimeOut);
   aFifoSize:=TPipe.ValidateFifoSize(aFifoSize*KiloByte);
   Result:=NewPipe(aHost,aName,aReporter,aDelay,aPriority,aFifoSize*DefPipeFactor,aFifoSize,aTimeOut);
   Result.ListenPeriod:=aListen;
  end;
 except
  on E:Exception do BugReport(E,nil,'NewPipeFromIniFile');
 end;
end;

function  NewPipe(const aHost : LongString;
                  const aName : LongString;
                  aReporter   : TPipeReporter;
                  aDelay      : Integer;
                  aPriority   : TThreadPriority;
                  aRxFifoSize : LongInt;
                  aTxFifoSize : LongInt;
                  aTimeOut    : Integer
                            ) : TPipe;
begin
 Result:=nil;
 try
  Result:=TPipe.Create(aHost,aName,aReporter,
          TPipe.ValidateDelay(aDelay),
          TPipe.ValidatePriority(aPriority),
          TPipe.ValidateFifoSize(aRxFifoSize),
          TPipe.ValidateFifoSize(aTxFifoSize),
          TPipe.ValidateTimeout(aTimeOut));
 except
  on E:Exception do BugReport(E,nil,'NewPipe');
 end;
end;

procedure Kill(var TheObject:TPipe); overload;
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E,nil,'Kill');
 end;
end;

procedure aPipeProperties(Index:LongInt; const aObject:TObject; var Terminate:Boolean; CustomData:Pointer);
begin
 if (aObject is TPipe) then
 with TPipe(aObject) do begin
  TText(CustomData).Addln(Format('[pipe:%s]',[PipeName]));
  TText(CustomData).Text:=TText(CustomData).Text+GetProperties;
 end;
end;

function GetFullPipeListProperties(TheText:TText):TText;
begin
 Result:=TheText;
 FullPipeList.ForEach(aPipeProperties,TheText);
end;

function GetFullPipeListPropertiesAsText:LongString;
var T:TText;
begin
 Result:='';
 try
  T:=NewText;
  try
   Result:=GetFullPipeListProperties(T).Text;
  finally
   Kill(T);
  end;
 except
  on E:Exception do BugReport(E,nil,'GetFullPipeListPropertiesAsText');
 end;
end;

const
 TheFullPipeList : TObjectStorage = nil;

function FullPipeList:TObjectStorage;
begin
 if not Assigned(TheFullPipeList) then begin
  TheFullPipeList:=NewObjectStorage(false);
  TheFullPipeList.Master:=@TheFullPipeList;
  TheFullPipeList.OwnsObjects:=false;
 end;
 Result:=TheFullPipeList;
end;

 /////////////////////////
 // EasyIPC implementation
 /////////////////////////
function EasyIpc_Init(const PipeName,Options:LongString):Integer;
var RxBuffSize,TxBuffSize,TimeOut,ListenPeriod,LogsHistory,Delay:Integer;
var Host,Name:LongString;
begin
 Delay:=TPipe.DefDelay;
 Timeout:=TPipe.DefTimeout;
 ListenPeriod:=TPipe.DefListenPeriod;
 RxBuffSize:=TPipe.DefFifoSize;
 TxBuffSize:=TPipe.DefFifoSize;
 LogsHistory:=TPipe.DefHistory;
 if (Options<>'') then begin
  TimeOut:=StrToIntDef(CookieScan(Options,'TimeOut'),Timeout);
  RxBuffSize:=StrToIntDef(CookieScan(Options,'RxBuffSize'),RxBuffSize);
  TxBuffSize:=StrToIntDef(CookieScan(Options,'TxBuffSize'),TxBuffSize);
  LogsHistory:=StrToIntDef(CookieScan(Options,'LogsHistory'),LogsHistory);
 end;
 Name:=ExtractFileName(PipeName);
 Host:=ExtractFilename(ExtractFileDir(PipeName));
 Result:=NewPipe(Host,Name,nil,Delay,TPipe.DefPriority,RxBuffSize,TxBuffSize,TimeOut).Ref;
 EasyIpc_Ctrl(Result,'LogsHistory='+IntToStr(LogsHistory));
 EasyIpc_Ctrl(Result,'ListenPeriod='+IntToStr(ListenPeriod));
end;

function EasyIpc_Ref(ipc:Integer):TPipe;
var Obj:TObject;
begin
 if (ipc<>0) then Obj:=ObjectRegistry[ipc] else Obj:=nil;
 if (Obj is TPipe) then Result:=TPipe(Obj) else Result:=nil;
end;

function EasyIpc_Free(ipc:Integer):Boolean;
var pipe:TPipe;
begin
 pipe:=EasyIpc_Ref(ipc);
 Result:=Assigned(pipe);
 if Result then Kill(pipe);
end;

function EasyIpc_Poll(ipc:Integer):Boolean;
begin
 Result:=EasyIpc_Ref(ipc).Ok;
end;

function EasyIpc_Send(ipc:Integer; const TextLines:LongString):Boolean;
begin
 Result:=false;
 if (ipc=0) then Exit; if (TextLines='') then Exit;
 Result:=(EasyIpc_Ref(ipc).Send(AdjustLineBreaks(TextLines))>0);
end;

function EasyIpc_Recv(ipc:Integer; Count:Integer):LongString;
begin
 Result:='';
 if (ipc=0) then Exit; if (Count<=0) then Exit;
 Result:=AdjustLineBreaks(EasyIpc_Ref(ipc).Recv(Count));
end;

function EasyIpc_Ctrl(ipc:Integer; const arg:LongString):LongString;
begin
 Result:='';
 if (ipc=0) then Exit; if IsEmptyStr(arg) then Exit;
 Result:=EasyIpc_Ref(ipc).Ctrl(arg);
end;

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

procedure Init_crw_pipe;
begin
 InitDictionary;
 TPipe.DefDelay:=4;
 TPipe.DefHistory:=16;
 TPipe.DefTimeout:=1000;
 TPipe.DefListenPeriod:=500;
 TPipe.DefFifoSize:=KiloByte*16;
 TPipe.DefPriority:=DefPipePriority;
 FullPipeList.Ok;
 dlc_NamedPipe:=RegisterDebugLogChannel('_NamedPipe');
end;

procedure Free_crw_pipe;
begin
 ResourceLeakageLog(Format('%-60s = %d',['FullPipeList.Count', TheFullPipeList.Count]));
 Kill(TheFullPipeList);
 FreeDictionary;
end;

initialization

 Init_crw_pipe;

finalization

 Free_crw_pipe;

end.

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

