////////////////////////////////////////////////////////////////////////////////
// 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:                                                                   //
// IANA Port Manager - database of IANA registered ports.                     //
////////////////////////////////////////////////////////////////////////////////

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

////////////////////////////////////////////////////////////////////////////////
// NetStat Information:
// Linux:   sudo -n netstat -tuan4p   - tcp udp all numerical ip4 PID
// Windows: netstat -nao              - numerical all output-PID
////////////////////////////////////////////////////////////////////////////////
// https://man7.org/linux/man-pages/man8/netstat.8.html
////////////////////////////////////////////////////////////////////////////////
// ESTABLISHED  The socket has an established connection.
// SYN_SENT     The socket is actively attempting to establish a connection.
// SYN_RECV     A connection request has been received from the network.
// FIN_WAIT1    The socket is closed, and the connection is shutting down.
// FIN_WAIT2    Connection is closed, socket waiting shutdown from remote end.
// TIME_WAIT    Socket waiting after close to handle packets still in network.
// CLOSE        The socket is not being used.
// CLOSE_WAIT   The remote end has shut down, waiting for the socket to close.
// LAST_ACK     Remote end shutdown, socket closed. Waiting for acknowledgement.
// LISTEN       The socket is listening for incoming connections.
// CLOSING      Both sockets shutdown but still don't have all our data sent.
// UNKNOWN      The state of the socket is unknown.
////////////////////////////////////////////////////////////////////////////////
// https://man7.org/linux/man-pages/man8/ss.8.html
////////////////////////////////////////////////////////////////////////////////
// All standard TCP states:
// ESTABLISHED, SYN-SENT, SYN-RECV, FIN-WAIT-1, FIN-WAIT-2, TIME-WAIT,
// CLOSED, CLOSE-WAIT, LAST-ACK, LISTENING, CLOSING.
////////////////////////////////////////////////////////////////////////////////
// https://geeksinfo.ru/komanda-netstat
////////////////////////////////////////////////////////////////////////////////
// CLOSE_WAIT         — Удаленная сторона отключилась; ожидание закрытия сокета.
// CLOSED             — Закрыт. Сокет не используется.
// ESTABLISHED        — Соединение установлено.
// FIN_WAIT_1         — Сокет закрыт; отключение соединения.
// FIN_WAIT_2         — Сокет закрыт; ожидание отключения удаленной стороны.
// LAST_ACK           — Удаленная сторона отключилась, затем сокет закрыт; ожидание подтверждения.
// LISTEN (LISTENING) — Ожидает входящих соединений.
// SYN_RECEIVED       — Идет начальная синхронизация соединения.
// SYN_SENT           — Активно пытается установить соединение.
// TIME_WAIT          — Сокет закрыт, но ожидает пакеты, ещё находящиеся в сети для обработки
// CLOSING            — Сокет закрыт, затем удаленная сторона отключилась; ожидание подтверждения.
////////////////////////////////////////////////////////////////////////////////

unit _crw_iana; // IANA Port Manager.

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

interface

uses
 //////////////////////////////////////////////////////
 {$I _crw_uses_first.inc} // NB: MUST BE FIRST USES !!!
 //////////////////////////////////////////////////////
 sysutils, classes, math, process, strutils, fileutil,
 _crw_alloc, _crw_ef, _crw_rtc, _crw_str, _crw_fio, _crw_sect,
 _crw_uri, _crw_proc, _crw_dbglog, _crw_task, _crw_polling,
 _crw_dbcon, _crw_dbapi;

type
 TIanaSystPorts = 0..1023;      // System  ports
 TIanaUserPorts = 1024..49151;  // User    ports
 TIanaDynaPorts = 49152..65535; // Dynamic ports

const
 IanaPortNumMin = Low(TIanaSystPorts);
 IanaPortNumMax = High(TIanaDynaPorts);
 IanaPortNumLen = IanaPortNumMax-IanaPortNumMin+1;
 IanaPortsDbKey = 'iana-ports.db';

const
 ipf_Registered = $01; // Port marked as Registered in IANA database
 ipf_Unassigned = $02; // Port marked as Unassigned in IANA database
 ipf_Service    = $04; // Port marked as Service    in /etc/services
 ipf_UserDef    = $08; // Port marked as User Defined
 ipf_Listen     = $10; // Port marked as Listening
 ipf_Establ     = $20; // Port marked as Established
 ipf_Used       = $40; // Port marked as Used
 ipf_Busy       = ipf_Service or ipf_UserDef or ipf_Listen or ipf_Establ or ipf_Used;

const
 SectUserDefinedIpPorts = '[User-Defined-IP-Ports]';

type
 TPortStatRec = packed record
  UserDefined : Integer; // User Defined in SysIniFile [User-Defined-IP-Ports]
  Established : Integer; // Connection established
  Registered  : Integer; // IANA registered ports
  Unassigned  : Integer; // IANA unassigned ports
  Listening   : Integer; // Listening connection
  Services    : Integer; // Defined in /etc/services
  Used        : Integer; // Marked as Used
 end;

type
 TIanaPortFlag = Byte;
 TIanaPortManager = class(TLatch)
 private
  myPortFlags : array of TIanaPortFlag;
  myPortStat  : TPortStatRec;
  myDatabase  : LongString;
  myUserDefs  : LongString;
  myNetTab    : LongString;
  myLsifTab   : LongString;
  myPidList   : TRunningProcessList;
  myPolling   : TPolling;
  myPeriod    : Integer;
  myPostBox   : record Lsif,Stat:record cmd,ans:LongString; end;end;
  procedure   InitPortFlags;
  procedure   FreePortFlags;
  function    GetDatabase:LongString;
  procedure   SetDatabase(aDatabase:LongString);
  function    GetPortFlags(p:Integer):TIanaPortFlag;
  procedure   SetPortFlags(p:Integer; Flag:TIanaPortFlag);
  function    GetPortStat:TPortStatRec;
  function    GetConnectionString:LongString;
  function    GetNetTab:LongString;
  procedure   SetNetTab(aTab:LongString);
  function    GetLsifTab:LongString;
  procedure   SetLsifTab(aTab:LongString);
  function    GetUserDefs:LongString;
  procedure   SetUserDefs(aDef:LongString);
  function    GetPeriod:Integer;
  procedure   SetPeriod(aPeriod:Integer);
  function    GetPostBoxCmdAns(c:Char; out cmd,ans:LongString):Integer;
  function    SetPostBoxCmdAns(c:Char; const cmd,ans:LongString):Integer;
 protected
  property    NetTab:LongString read GetNetTab write SetNetTab;
  property    LsifTab:LongString read GetLsifTab write SetLsifTab;
  property    UserDefs:LongString read GetUserDefs write SetUserDefs;
 public
  constructor Create;
  destructor  Destroy; override;
  procedure   AfterConstruction; override;
  procedure   BeforeDestruction; override;
 public
  property  Database             : LongString    read GetDatabase  write SetDatabase;
  property  PortFlags[p:Integer] : TIanaPortFlag read GetPortFlags write SetPortFlags;
  property  ConnectionString     : LongString    read GetConnectionString;
  property  PortStat             : TPortStatRec  read GetPortStat;
  property  Period               : Integer       read GetPeriod    write SetPeriod;
 public
  procedure Reset;
  procedure ReInit;
  procedure PollHandler;
  function  BriefStatInfo:LongString;
  function  FetchEtcServicesInfo(aPort:Integer; aPrefix:LongString):LongString;
  function  FetchPortInfo(aPort:Integer; const Delim:LongString=EOL; SkipEmpty:Boolean=True):LongString;
  function  FetchUserPortInfo(aPort:Integer; const Delim:LongString=EOL):LongString;
  function  CountPortsWithFlag(FI:TIanaPortFlag; FE:TIanaPortFlag=0;
                               p1:Integer=0; p2:Integer=MaxInt):Integer;
  function  FindFreeUserPort(pUse:Boolean=False;
                             pOrd:Integer=0;
                             pMin:Integer=Low(TIanaUserPorts);
                             pMax:Integer=High(TIanaUserPorts)
                             ):Integer;
  function  PortFlagsOr(p:Integer; Flag:TIanaPortFlag):Integer;
  function  PortFlagsRangeOr(p1,p2:Integer; Flag:TIanaPortFlag):Integer;
  function  FetchNetStatTable(aRefresh:Boolean=False):LongString;
  function  FetchLsifTable(aRefresh:Boolean=False):LongString;
  function  Ctrl(const args:LongString):LongString;
 protected
  function  ReadIniDatabase(aIni:LongString='';
                            aSec:LongString='';
                            aKey:LongString='';
                            aRefresh:Boolean=True):LongString;
  function  RefreshUserDefinedPorts(aLines:LongString):Integer;
  function  ParseNetStat(const ans:LongString; out buf:LongString):Integer;
  function  RefreshUnassigned:Integer;
  function  RefreshServices:Integer;
  function  RefreshNetStat(const aCmd:LongString=''; const aAns:LongString=''):Integer;
  function  RefreshLsif(const aCmd:LongString=''; const aAns:LongString=''):Integer;
 public
  class var NetStatTimeout:Integer;
  class function ValidPortNumber(aPort:Integer):Boolean;
  class function PortFlagIsFree(Flag:TIanaPortFlag):Boolean;
  class function PortFlagToString(Flag:TIanaPortFlag):LongString;
  class function CallLsif(out cmd,ans:LongString; aTimeout:Integer=0):Boolean;
  class function CallNetStat(out cmd,ans:LongString; aTimeout:Integer=0):Boolean;
  class function FormatNetTabRow(const Prot,LAddr,LPort,RAddr,RPort,Stat,sPid:LongString):LongString;
 end;

function IanaMan:TIanaPortManager;

procedure Init_IanaPorts;
procedure Timer_IanaPorts;

function dlc_IanaLog:Integer;
function dlc_IanaBug:Integer;

implementation

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

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

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

///////////////////
// Service routines
///////////////////

procedure Init_IanaPorts;
begin
 try
  IanaMan.ReInit;
 except
  on E:Exception do BugReport(E,IanaMan,'Init_IanaPorts');
 end;
end;

procedure Timer_IanaPorts;
begin
 try
  IanaMan.PollHandler;
 except
  on E:Exception do BugReport(E,IanaMan,'Timer_IanaPorts');
 end;
end;

////////////////////////////////////
// TIanaPortManager polling callback
////////////////////////////////////

procedure IanaManPollAct(aPolling:TPolling; var Terminate:Boolean);
var Man:TIanaPortManager; Period:Integer; cmd,ans:LongString;
begin
 Man:=nil; Period:=0;
 if Assigned(aPolling) then
 if (aPolling.LinkObject is TIanaPortManager)
 then Man:=TIanaPortManager(aPolling.LinkObject);
 if Assigned(Man) then Period:=Man.Period else Exit;
 if (Period<=0) or ((aPolling.LoopCount mod Period)<>0) then Exit;
 // Call netstat …
 cmd:=''; ans:='';
 if Man.CallNetStat(cmd,ans)
 then Man.SetPostBoxCmdAns('s',cmd,ans);
 // Call lsif …
 cmd:=''; ans:='';
 if Man.CallLsif(cmd,ans)
 then Man.SetPostBoxCmdAns('l',cmd,ans);
end;

//////////////////////////////////
// TIanaPortManager implementation
//////////////////////////////////

constructor TIanaPortManager.Create;
begin
 inherited Create;
 if IsWindows then begin
  myPidList:=NewRunningProcessList;
  myPidList.Master:=@myPidList;
 end else myPidList:=nil;
 myPolling:=NewPolling(IanaManPollAct,1000,tpNormal,False,'System.NetStat');
 myPolling.Master:=@myPolling;
 myPolling.LinkObject:=Self;
 myDatabase:='';
 myUserDefs:='';
 myLsifTab:='';
 myNetTab:='';
 myPostBox.Lsif.cmd:='';
 myPostBox.Lsif.ans:='';
 myPostBox.Stat.cmd:='';
 myPostBox.Stat.ans:='';
end;

destructor TIanaPortManager.Destroy;
begin
 myPostBox.Lsif.cmd:='';
 myPostBox.Lsif.ans:='';
 myPostBox.Stat.cmd:='';
 myPostBox.Stat.ans:='';
 myNetTab:='';
 myLsifTab:='';
 myUserDefs:='';
 myDatabase:='';
 Kill(myPidList);
 Kill(myPolling);
 inherited Destroy;
end;

procedure TIanaPortManager.AfterConstruction;
begin
 inherited AfterConstruction;
 InitPortFlags;
 Reset;
 myPolling.Enabled:=True;
end;

procedure TIanaPortManager.BeforeDestruction;
begin
 myPolling.Enabled:=False;
 FreePortFlags;
 inherited BeforeDestruction;
end;

procedure TIanaPortManager.ReInit;
begin
 if Assigned(Self) then
 try
  Reset;
  ReadIniDatabase;
  RefreshServices;
  RefreshNetStat;
  RefreshLsif;
 except
  on E:Exception do BugReport(E,Self,'ReInit');
 end;
end;

procedure TIanaPortManager.PollHandler;
var cmd,ans:LongString;
begin
 if Assigned(Self) then
 try
  cmd:=''; ans:=''; // Handle lsif call
  if (GetPostBoxCmdAns('l',cmd,ans)>0) then
  if IsNonEmptyStr(cmd) then begin
   SetPostBoxCmdAns('l','','');
   RefreshLsif(cmd,ans);
  end;
  cmd:=''; ans:=''; // Handle netstat call
  if (GetPostBoxCmdAns('s',cmd,ans)>0) then
  if IsNonEmptyStr(cmd) then begin
   SetPostBoxCmdAns('s','','');
   RefreshNetStat(cmd,ans);
  end;
 except
  on E:Exception do BugReport(E,Self,'PollHandler');
 end;
end;

procedure TIanaPortManager.InitPortFlags;
begin
 SetLength(myPortFlags,IanaPortNumLen);
end;

procedure TIanaPortManager.FreePortFlags;
begin
 SetLength(myPortFlags,0);
end;

procedure TIanaPortManager.Reset;
var i:Integer;
begin
 if Assigned(Self) then begin
  Lock;
  try
   myPortStat:=Default(TPortStatRec);
   for i:=Low(myPortFlags) to High(myPortFlags)
   do myPortFlags[i]:=0;
   myUserDefs:='';
   myLsifTab:='';
   myNetTab:='';
   myPostBox.Lsif.cmd:='';
   myPostBox.Lsif.ans:='';
   myPostBox.Stat.cmd:='';
   myPostBox.Stat.ans:='';
  finally
   Unlock;
  end;
 end;
end;

function TIanaPortManager.GetPortFlags(p:Integer):TIanaPortFlag;
begin
 Result:=0;
 if Assigned(Self) then
 if InRange(p,Low(myPortFlags),High(myPortFlags)) then Result:=myPortFlags[p];
end;

procedure TIanaPortManager.SetPortFlags(p:Integer; Flag:TIanaPortFlag);
begin
 if Assigned(Self) then
 if InRange(p,Low(myPortFlags),High(myPortFlags)) then begin
  Lock;
  try
   myPortFlags[p]:=Flag;
  finally
   Unlock;
  end;
 end;
end;

function TIanaPortManager.PortFlagsOr(p:Integer; Flag:TIanaPortFlag):Integer;
begin
 Result:=0;
 if Assigned(Self) then
 if InRange(p,Low(myPortFlags),High(myPortFlags)) then begin
  Lock;
  try
   myPortFlags[p]:=myPortFlags[p] or Flag;
   Inc(Result);
  finally
   Unlock;
  end;
 end;
end;

function TIanaPortManager.PortFlagsRangeOr(p1,p2:Integer; Flag:TIanaPortFlag):Integer;
var p,LR,HR:Integer;
begin
 Result:=0;
 // Single port?
 if (p1=p2) then begin
  Result:=PortFlagsOr(p1,Flag);
  Exit;
 end;
 if Assigned(Self) then begin
  LR:=Low(myPortFlags); HR:=High(myPortFlags);
  p1:=Max(p1,LR); p2:=Min(p2,HR); if (p1>p2) then Exit;
  if InRange(p1,LR,HR) and InRange(p2,LR,HR) and (p1<=p2) then begin
   Lock;
   try
    for p:=p1 to p2 do begin
     myPortFlags[p]:=myPortFlags[p] or Flag;
     Inc(Result);
    end;
   finally
    Unlock;
   end;
  end;
 end;
end;

function TIanaPortManager.GetPortStat:TPortStatRec;
begin
 if Assigned(Self)
 then Result:=myPortStat
 else Result:=Default(TPortStatRec);
end;

function TIanaPortManager.GetDatabase:LongString;
begin
 if Assigned(Self)
 then Result:=myDatabase
 else Result:='';
end;

procedure TIanaPortManager.SetDatabase(aDatabase:LongString);
begin
 if Assigned(Self)
 then myDatabase:=UnifyFileAlias(AdaptFileName(aDatabase),ua_FileLow);
end;

function TIanaPortManager.GetPeriod:Integer;
begin
 if Assigned(Self)
 then Result:=myPeriod
 else Result:=0;
end;

procedure TIanaPortManager.SetPeriod(aPeriod:Integer);
begin
 if Assigned(Self)
 then myPeriod:=Max(0,aPeriod);
end;

function TIanaPortManager.GetPostBoxCmdAns(c:Char; out cmd,ans:LongString):Integer;
const LsifChars=['l','L']; StatChars=['s','S'];
begin
 Result:=0; cmd:=''; ans:='';
 if (c in LsifChars+StatChars) then
 if Assigned(Self) then begin
  Lock;
  try
   if c in LsifChars then begin
    cmd:=myPostBox.Lsif.cmd;
    ans:=myPostBox.Lsif.ans;
    if (cmd<>'') then Inc(Result);
   end;
   if c in StatChars then begin
    cmd:=myPostBox.Stat.cmd;
    ans:=myPostBox.Stat.ans;
    if (cmd<>'') then Inc(Result);
   end;
  finally
   Unlock;
  end;
 end;
end;

function TIanaPortManager.SetPostBoxCmdAns(c:Char; const cmd,ans:LongString):Integer;
const LsifChars=['l','L']; StatChars=['s','S'];
begin
 Result:=0;
 if (c in LsifChars+StatChars) then
 if Assigned(Self) then begin
  Lock;
  try
   if c in LsifChars then begin
    myPostBox.Lsif.cmd:=cmd;
    myPostBox.Lsif.ans:=ans;
    Inc(Result);
   end;
   if c in StatChars then begin
    myPostBox.Stat.cmd:=cmd;
    myPostBox.Stat.ans:=ans;
    Inc(Result);
   end;
  finally
   Unlock;
  end;
 end;
end;

function TIanaPortManager.BriefStatInfo:LongString;
begin
 Result:='';
 if Assigned(Self) then begin
  with myPortStat do
  Result:=Format('Registered:%d, Unassigned:%d, Services:%d, UserDefined:%d, Listening:%d, Established:%d, Used:%d',
                [Registered,Unassigned,Services,UserDefined,Listening,Established,Used]);
 end;
end;

function TIanaPortManager.ReadIniDatabase(aIni:LongString='';
                                          aSec:LongString='';
                                          aKey:LongString='';
                                          aRefresh:Boolean=True):LongString;
var dbf,usr:LongString;
begin
 Result:=''; dbf:='';
 if IsMainThread then
 if Assigned(Self) then
 try
  aIni:=TrimDef(aIni,SysIniFile);
  aSec:=TrimDef(aSec,SectSystem);
  aKey:=TrimDef(aKey,IanaPortsDbKey);
  if ReadIniFilePath(aIni,aSec,aKey,HomeDir,dbf) then begin
   if FileIsReadable(dbf) and EndsText('.db',dbf) then begin
    Database:=UnifyFileAlias(dbf,ua_FileLow);
    if aRefresh then RefreshUnassigned;
    Result:=Database;
    DebugLog(dlc_IanaLog,'Read IANA database '+dbf);
   end else DebugLog(dlc_IanaBug,'Invalid file '+dbf);
  end else DebugLog(dlc_IanaBug,'Could not read '+aIni);
  usr:=ExtractTextSection(aIni,SectUserDefinedIpPorts,efConfigNC);
  if IsNonEmptyStr(usr) then RefreshUserDefinedPorts(usr);
  UserDefs:=usr;
 except
  on E:Exception do BugReport(E,Self,'ReadIniDatabase');
 end;
end;

function TIanaPortManager.RefreshUserDefinedPorts(aLines:LongString):Integer;
var Lines:TStringList; Line:LongString; il:Integer;
var w1,w2:LongString; p1,p2:Integer;
begin
 Result:=0;
 if Assigned(Self) then
 try
  Lines:=TStringList.Create;
  try
   Lines.Text:=aLines;
   for il:=0 to Lines.Count-1 do begin
    Line:=Lines[il];
    if IsEmptyStr(Line) then continue;
    w1:=ExtractWord(1,Line,ScanSpaces);
    w2:=ExtractWord(2,Line,ScanSpaces);
    if (WordIndex(w1,'TCP,UDP',ScanSpaces)>0) then begin
     if HasChars(w2,['-']) then begin
      p1:=StrToIntDef(StrAheadOf(w2,'-'),-1);
      p2:=StrToIntDef(StrAfterOf(w2,'-'),-1);
     end else begin
      p1:=StrToIntDef(w2,-1);
      p2:=p1;
     end;
     if (p1<=p2) then
     if ValidPortNumber(p1) and ValidPortNumber(p2)
     then PortFlagsRangeOr(p1,p2,ipf_UserDef);
    end;
   end;
   Result:=CountPortsWithFlag(ipf_UserDef);
   myPortStat.UserDefined:=Result;
  finally
   Kill(Lines);
  end;
 except
  on E:Exception do BugReport(E,Self,'RefreshUserDefinedPorts');
 end;
end;

function TIanaPortManager.CountPortsWithFlag(FI:TIanaPortFlag; FE:TIanaPortFlag=0;
                                             p1:Integer=0; p2:Integer=MaxInt):Integer;
var i:Integer; PF:TIanaPortFlag;
begin
 Result:=0;
 if (FI<>0) then
 if Assigned(Self) then
 try
  p1:=EnsureRange(p1,Low(myPortFlags),High(myPortFlags));
  p2:=EnsureRange(p2,Low(myPortFlags),High(myPortFlags));
  for i:=p1 to p2 do begin
   PF:=myPortFlags[i];
   if ((PF and FE)<>0) then continue;
   if ((PF and FI)<>0) then Inc(Result);
  end;
 except
  on E:Exception do BugReport(E,Self,'CountPortsWithFlag');
 end;
end;

function TIanaPortManager.GetConnectionString:LongString;
begin
 Result:=Format('Provider=SQLite3;Database=%s;Charset=utf8;',[Database]);
end;

function TIanaPortManager.GetNetTab:LongString;
begin
 Result:='';
 if Assigned(Self) then
 try
  Lock;
  try
   Result:=myNetTab;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetNetTab');
 end;
end;

procedure TIanaPortManager.SetNetTab(aTab:LongString);
begin
 if Assigned(Self) then
 try
  Lock;
  try
   myNetTab:=aTab;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'SetNetTab');
 end;
end;

function TIanaPortManager.GetLsifTab:LongString;
begin
 Result:='';
 if Assigned(Self) then
 try
  Lock;
  try
   Result:=myLsifTab;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetLsifTab');
 end;
end;

procedure TIanaPortManager.SetLsifTab(aTab:LongString);
begin
 if Assigned(Self) then
 try
  Lock;
  try
   myLsifTab:=aTab;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'SetLsifTab');
 end;
end;

function TIanaPortManager.GetUserDefs:LongString;
begin
 Result:='';
 if Assigned(Self) then
 try
  Lock;
  try
   Result:=myUserDefs;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'GetUserDefs');
 end;
end;

procedure TIanaPortManager.SetUserDefs(aDef:LongString);
begin
 if Assigned(Self) then
 try
  Lock;
  try
   myUserDefs:=aDef;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'SetUserDefs');
 end;
end;

function TIanaPortManager.RefreshUnassigned:Integer;
var dbc,dbr,pn1,pn2,nsuc:Integer; sql,line,msg:LongString; ms:QWord;
const Delims=JustSpaces+['-'];
begin
 Result:=0;
 if Assigned(Self) then
 try
  //
  // Read all unassigned port numbers
  //
  ms:=GetTickCount64; nsuc:=0;
  if FileIsReadable(Database) and EndsText('.db',Database) then begin
   dbc:=db_connection(db_engine_sqldb,ConnectionString);
   if (dbc<>0) then
   try
    sql:='select * from iana_ports where description="unassigned" collate nocase;';
    if db_open(dbc,adConnectUnspecified) then
    try
     if db_begintrans(dbc)>0 then
     try
      dbr:=db_execute(dbc,sql,adCmdText).ref;
      if db_fieldscount(dbr)>0 then
      while not db_eof(dbr) do begin
       line:=db_fieldsasstring(dbr,'port_number','r','');
       pn1:=-1; pn2:=-1;
       case WordCount(line,Delims) of
        1: begin
         pn1:=StrToIntDef(ExtractWord(1,line,Delims),-1);
         pn2:=pn1;
        end;
        2: begin
         pn1:=StrToIntDef(ExtractWord(1,line,Delims),-1);
         pn2:=StrToIntDef(ExtractWord(2,line,Delims),-1);
        end;
       end;
       if ValidPortNumber(pn1) and ValidPortNumber(pn2) then
       if (pn1>=0) and (pn2>=0) and (pn2>=pn1) then begin
        nsuc+=PortFlagsRangeOr(pn1,pn2,ipf_Unassigned or ipf_Registered);
       end;
       if not db_movenext(dbr) then break;
      end;
     finally
      db_committrans(dbc);
     end;
    finally
     db_close(dbc);
    end;
    myPortStat.Unassigned:=CountPortsWithFlag(ipf_Unassigned);
   finally
    db_free(dbc);
   end;
   ms:=GetTickCount64-ms;
   msg:=Format('Read %d Unassigned from %s, %d ms elapsed.',[nsuc,Database,ms]);
   if (ThisProcessUptimeMsec<60000) then DebugOut(stdfDebug,msg);
   DebugLog(dlc_IanaLog,msg);
  end else DebugLog(dlc_IanaBug,'Invalid file '+Database);
  //
  // Read all registered ports numbers
  //
  ms:=GetTickCount64; nsuc:=0;
  if FileIsReadable(Database) and EndsText('.db',Database) then begin
   dbc:=db_connection(db_engine_sqldb,ConnectionString);
   if (dbc<>0) then
   try
    sql:='select * from iana_ports where not port_number="";';
    if db_open(dbc,adConnectUnspecified) then
    try
     if db_begintrans(dbc)>0 then
     try
      dbr:=db_execute(dbc,sql,adCmdText).ref;
      if db_fieldscount(dbr)>0 then
      while not db_eof(dbr) do begin
       line:=db_fieldsasstring(dbr,'port_number','r','');
       pn1:=-1; pn2:=-1;
       case WordCount(line,Delims) of
        1: begin
         pn1:=StrToIntDef(ExtractWord(1,line,Delims),-1);
         pn2:=pn1;
        end;
        2: begin
         pn1:=StrToIntDef(ExtractWord(1,line,Delims),-1);
         pn2:=StrToIntDef(ExtractWord(2,line,Delims),-1);
        end;
       end;
       if ValidPortNumber(pn1) and ValidPortNumber(pn2) then
       if (pn1>=0) and (pn2>=0) and (pn2>=pn1) then begin
        nsuc+=PortFlagsRangeOr(pn1,pn2,ipf_Registered);
       end;
       if not db_movenext(dbr) then break;
      end;
     finally
      db_committrans(dbc);
     end;
    finally
     db_close(dbc);
    end;
    myPortStat.Registered:=CountPortsWithFlag(ipf_Registered);
   finally
    db_free(dbc);
   end;
   ms:=GetTickCount64-ms;
   msg:=Format('Read %d Registered from %s, %d ms elapsed.',[nsuc,Database,ms]);
   if (ThisProcessUptimeMsec<60000) then DebugOut(stdfDebug,msg);
   DebugLog(dlc_IanaLog,msg);
  end else DebugLog(dlc_IanaBug,'Invalid file '+Database);
  Result:=myPortStat.Unassigned;
 except
  on E:Exception do BugReport(E,Self,'RefreshUnassigned');
 end;
end;

function TIanaPortManager.FetchPortInfo(aPort:Integer; const Delim:LongString=EOL; SkipEmpty:Boolean=True):LongString;
var dbc,dbr,i,pn1,pn2,pf:Integer; sql,line,skey,sval,msg:LongString; ms:QWord;
const Delims=JustSpaces+['-'];
begin
 Result:='';
 if Assigned(Self) then
 try
  if ValidPortNumber(aPort) then begin
   pf:=PortFlags[aPort];
   Result+=Format('PortFlags=0x%x,%s',[pf,PortFlagToString(pf)])+EOL;
   if HasFlags(pf,ipf_Registered) then begin
    //
    // Read all registered ports numbers to find aPort
    //
    ms:=GetTickCount64;
    if FileIsReadable(Database) and EndsText('.db',Database) then begin
     dbc:=db_connection(db_engine_sqldb,ConnectionString);
     if (dbc<>0) then
     try
      sql:='select * from iana_ports where not port_number="";';
      if db_open(dbc,adConnectUnspecified) then
      try
       if db_begintrans(dbc)>0 then
       try
        dbr:=db_execute(dbc,sql,adCmdText).ref;
        if db_fieldscount(dbr)>0 then
        while not db_eof(dbr) do begin
         line:=db_fieldsasstring(dbr,'port_number','r','');
         pn1:=-1; pn2:=-1;
         case WordCount(line,Delims) of
          1: begin
           pn1:=StrToIntDef(ExtractWord(1,line,Delims),-1);
           pn2:=pn1;
          end;
          2: begin
           pn1:=StrToIntDef(ExtractWord(1,line,Delims),-1);
           pn2:=StrToIntDef(ExtractWord(2,line,Delims),-1);
          end;
         end;
         if InRange (aPort,pn1,pn2) then
         if ValidPortNumber(pn1) and ValidPortNumber(pn2) then
         if (pn1>=0) and (pn2>=0) and (pn2>=pn1) then begin
          for i:=0 to db_fieldscount(dbr)-1 do begin
           skey:=db_fieldsnames(dbr,i);
           sval:=db_fieldsasstring(dbr,skey,'r','');
           if (PosEol(sval)>0) then begin
            sval:=ValidateEol(sval);
            sval:=StringReplace(sval,EOL,'\n',[rfReplaceAll]);
           end;
           if IsNonEmptyStr(sval) or not SkipEmpty
           then Result+=Format('%s=%s',[skey,sval])+EOL;
          end;
          if IsNonEmptyStr(Result) then break;
         end;
         if not db_movenext(dbr) then break;
        end;
       finally
        db_committrans(dbc);
       end;
      finally
       db_close(dbc);
      end;
     finally
      db_free(dbc);
     end;
     ms:=GetTickCount64-ms;
     msg:=Format('Read FetchPortInfo(%d) from "%s", %d ms elapsed.',[aPort,Database,ms]);
     DebugLog(dlc_IanaLog,msg);
    end else DebugLog(dlc_IanaBug,'Invalid file '+Database);
   end;
  end else begin
   Result+=Format('Invalid Port number %d',[aPort])+EOL;
  end;
  if (Result<>'') and (Delim<>'') and (Delim<>EOL)
  then Result:=StringReplace(Trim(Result),EOL,Delim,[rfReplaceAll]);
 except
  on E:Exception do BugReport(E,Self,'FetchPortInfo');
 end;
end;

function TIanaPortManager.FetchUserPortInfo(aPort:Integer; const Delim:LongString=EOL):LongString;
var i,p1,p2:Integer; line,w1,w2,w3,w4,buf:LongString;
begin
 Result:='';
 if Assigned(Self) then
 try
  buf:=UserDefs;
  if IsNonEmptyStr(buf) then
  if ValidPortNumber(aPort) then begin
   for i:=1 to WordCount(buf,EolnDelims) do begin
    line:=ExtractWord(i,buf,EolnDelims);
    w1:=ExtractPhrase(1,line,ScanSpaces);
    if (WordIndex(w1,'TCP,UDP',ScanSpaces)>0) then begin
     w2:=ExtractPhrase(2,line,ScanSpaces);
     w3:=ExtractPhrase(3,line,ScanSpaces);
     w4:=ExtractPhrase(4,line,ScanSpaces);
     if (Pos('-',w2)>0) then begin
      p1:=StrToIntDef(StrAheadOf(w2,'-'),-1);
      p2:=StrToIntDef(StrAfterOf(w2,'-'),-1);
     end else begin
      p1:=StrToIntDef(w2,-1);
      p2:=p1;
     end;
     if ValidPortNumber(p1) and ValidPortNumber(p2) then
     if (p1>0) and (p2>0) and (p1<=p2) and InRange(aPort,p1,p2) then begin
      Result+=Format('User Defined Port: %s %d %s %s',[w1,aPort,QArg(w3),QArg(w4)])+EOL;
     end;
    end;
   end;
   if (Result<>'') and (Delim<>'') and (Delim<>EOL)
   then Result:=StringReplace(Trim(Result),EOL,Delim,[rfReplaceAll]);
  end;
 except
  on E:Exception do BugReport(E,Self,'FetchUserPortInfo');
 end;
end;

function TIanaPortManager.RefreshServices:Integer;
var Lines:TStringList; Line:LongString; il:Integer;
var Port:Integer;
begin
 Result:=0;
 if IsMainThread then
 if Assigned(Self) then
 try
  Lines:=TStringList.Create;
  try
   Lines.Text:=UriMan.ServicePortList;
   for il:=0 to Lines.Count-1 do begin
    Line:=Lines[il];
    if IsEmptyStr(Line) then continue;
    Port:=StrToIntDef(StrAheadOf(Line,'/'),-1);
    if ValidPortNumber(Port) then begin
     PortFlagsOr(Port,ipf_Service);
    end;
   end;
   Result:=CountPortsWithFlag(ipf_Service);
   myPortStat.Services:=Result;
  finally
   Kill(Lines);
  end;
 except
  on E:Exception do BugReport(E,Self,'RefreshServices');
 end;
end;

function TIanaPortManager.FindFreeUserPort(pUse:Boolean=False;
                                           pOrd:Integer=0;
                                           pMin:Integer=Low(TIanaUserPorts);
                                           pMax:Integer=High(TIanaUserPorts)
                                           ):Integer;
var i,n,p,f:Integer;
 function MatchFlags(Flags:Integer):Boolean;
 begin
  Result:=False;
  if HasFlags(Flags,ipf_Busy) then Exit;
  if HasFlags(Flags,ipf_Registered) then
  if not HasFlags(Flags,ipf_Unassigned) then Exit;
  Inc(n); if (n>=pOrd) then Result:=True;
 end;
begin
 Result:=0;
 if Assigned(Self) then
 try
  n:=0; f:=0;
  pMin:=EnsureRange(pMin,IanaPortNumMin,IanaPortNumMax);
  pMax:=EnsureRange(pMax,IanaPortNumMin,IanaPortNumMax);
  for i:=pMin to pMax do begin
   if (pOrd>0) then p:=i else p:=pMin+Random(pMax-pMin+1);
   if InRange(p,pMin,pMax) then f:=PortFlags[p] else continue;
   if MatchFlags(f) then begin
    if pUse then PortFlagsOr(p,ipf_Used);
    if pUse then myPortStat.Used:=CountPortsWithFlag(ipf_Used);
    Result:=p;
    Exit;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'FindFreeUserPort');
 end;
end;

function TIanaPortManager.FetchEtcServicesInfo(aPort:Integer; aPrefix:LongString):LongString;
var stcp,sudp:LongString;
begin
 Result:='';
 if Assigned(Self) then
 try
  stcp:=UriMan.ServicePortInfo(aPort,'tcp');
  sudp:=UriMan.ServicePortInfo(aPort,'udp');
  if IsNonEmptyStr(stcp) then Result+=aPrefix+Format('%d tcp %s',[aPort,stcp])+EOL;
  if IsNonEmptyStr(sudp) then Result+=aPrefix+Format('%d udp %s',[aPort,sudp])+EOL;
 except
  on E:Exception do BugReport(E,Self,'EtcServicesInfo');
 end;
end;

class function TIanaPortManager.ValidPortNumber(aPort:Integer):Boolean;
begin
 Result:=InRange(aPort,IanaPortNumMin,IanaPortNumMax);
end;

class function TIanaPortManager.PortFlagIsFree(Flag:TIanaPortFlag):Boolean;
begin
 Result:=False;
 if HasFlags(Flag,ipf_Busy) then Exit;
 Result:=HasFlags(Flag,ipf_Unassigned) or not HasFlags(Flag,ipf_Registered);
end;

class function TIanaPortManager.PortFlagToString(Flag:TIanaPortFlag):LongString;
begin
 Result:='';
 if HasFlags(Flag,ipf_Registered) then Result+='Registered ';
 if HasFlags(Flag,ipf_Unassigned) then Result+='Unassigned ';
 if HasFlags(Flag,ipf_Service)    then Result+='Service ';
 if HasFlags(Flag,ipf_UserDef)    then Result+='UserDefined ';
 if HasFlags(Flag,ipf_Listen)     then Result+='Listening ';
 if HasFlags(Flag,ipf_Establ)     then Result+='Established ';
 if HasFlags(Flag,ipf_Used)       then Result+='Used ';
 if HasFlags(Flag,ipf_Busy)       then Result+='Busy ';
 if PortFlagIsFree(Flag)          then Result+='Free ';
 Result:=StringReplace(TrimDef(Result,'Unknown'),' ',',',[rfReplaceAll]);
end;

 // IanaMan.Ctrl('-stat');
 // IanaMan.Ctrl('-find'); IanaMan.Ctrl('-take');
 // IanaMan.Ctrl('-port'); IanaMan.Ctrl('-info');
function TIanaPortManager.Ctrl(const args:LongString):LongString;
var arg,w1,w2,w3,inf,ipas,macs,host:LongString; p1,p2,pt,pf,pp:Integer;
var aRefresh:Boolean;
 function FormatAddrList(const list:LongString):LongString;
 const MacBits=48; MacBytes=MacBits div 8; MacLen=MacBytes*3-1;
 var i:Integer;
 begin
  Result:='';
  for i:=1 to WordCount(list,ScanSpaces)
  do Result+=Pad(ExtractWord(i,list,ScanSpaces),MacLen)+'  ';
 end;
begin
 Result:='';
 if Assigned(Self) then
 try
  arg:=Trim(args);
  aRefresh:=IsMainThread;
  if IsNonEmptyStr(arg) then begin
   w1:=ExtractWord(1,arg,ScanSpaces);
   w2:=ExtractWord(2,arg,ScanSpaces);
   w3:=ExtractWord(3,arg,ScanSpaces);
   if IsOption(w1,'-init','--init') then begin
    ReInit;
    Exit;
   end else
   if IsOption(w1,'-poll','--poll') then begin
    pp:=StrToIntDef(w2,-1);
    if (pp>=0) then Period:=pp;
    Result:=IntToStr(Period);
    Exit;
   end else
   if IsOption(w1,'-p') or IsOption(w1,'-port','--port')
   or IsOption(w1,'-i') or IsOption(w1,'-info','--info') then begin
    pt:=StrToIntDef(w2,-1);
    if ValidPortNumber(pt) then begin
     pf:=PortFlags[pt]; inf:=FetchEtcServicesInfo(pt,'/etc/services: ');
     Result+=Format('Port %d marked as: 0x%x,%s',[pt,pf,PortFlagToString(pf)])+EOL;
     if IsNonEmptyStr(inf) then Result+=inf;
     inf:=FetchUserPortInfo(pt);
     if IsNonEmptyStr(inf) then Result+=inf;
     if HasChars(w1,['i','I'])
     then Result+=Format('Port %d Info:%s%s',[pt,EOL,FetchPortInfo(pt)])+EOL;
    end else Result+='Error: Invalid port number: '+w2+EOL;
    Exit;
   end else
   if IsOption(w1,'-f') or IsOption(w1,'-find','--find')
   or IsOption(w1,'-t') or IsOption(w1,'-take','--take') then begin
    p1:=StrToIntDef(w2,Low(TIanaUserPorts));
    p2:=StrToIntDef(w3,High(TIanaUserPorts));
    pt:=FindFreeUserPort(HasChars(w1,['t','T']),0,p1,p2);
    pf:=PortFlags[pt];
    if (pt>0) then begin
     Result+=Format('Port %d marked as: 0x%x,%s',[pt,pf,PortFlagToString(pf)])+EOL;
     if HasChars(w1,['t','T'])
     then Result+=Format('%d port taken free to use',[pt])+EOL
     else Result+=Format('%d port found free to use',[pt])+EOL;
    end else Result+='Error: Could not find free port'+EOL;
    Exit;
   end else
   if IsOption(w1,'-lsif','--lsif') then begin
    Result+=FetchLsifTable(aRefresh);
    Exit;
   end else
   if IsOption(w1,'-iplist','--iplist') then begin
    ipas:=GetIPAddresses;  ipas:=FormatAddrList(ipas);
    macs:=GetMacAddresses; macs:=FormatAddrList(macs);
    host:=HostName;        host:=Trim(LoCaseStr(host));
    Result+=('IP:   '+ipas)+EOL;
    Result+=('MAC:  '+macs)+EOL;
    Result+=('Host: '+host)+EOL;
    Exit;
   end else
   if IsOption(w1,'-s') or IsOption(w1,'-stat','--stat') then begin
    Result+=FetchNetStatTable(aRefresh);
    Result+='IANA Ports Stat: '+BriefStatInfo+EOL;
    pf:=CountPortsWithFlag(ipf_Unassigned,ipf_Busy);
    Result+=Format('%d port(s) looks free',[pf])+EOL;
    Exit;
   end;
  end;
 except
  on E:Exception do BugReport(E,Self,'Ctrl');
 end;
end;

function TIanaPortManager.FetchLsifTable(aRefresh:Boolean=False):LongString;
begin
 Result:='';
 if Assigned(Self) then begin
  if aRefresh then RefreshLsif;
  Result:=LsifTab;
 end;
end;

function TIanaPortManager.RefreshLsif(const aCmd:LongString=''; const aAns:LongString=''):Integer;
var cmd,exe,ans,line,ifs,typ,ipa,mac,ops,head,car,tab:LongString;
var dirs:TStringList; i,aTimeout:Integer; ms:Int64;
 function FormatLsifLine(const ifs,typ,ipa,mac,ops,car:LongString):LongString;
 begin
  Result:=Format('%-9s  %-8s  %-15s  %-17s  %-7s  %-7s',[ifs,typ,ipa,mac,ops,car]);
 end;
 function ArgLsif(out c,a:LongString):Boolean;
 begin
  Result:=False; c:=''; a:='';
  if IsNonEmptyStr(aCmd) then begin
   c:=aCmd; a:=aAns;
   Result:=True;
  end;
 end;
begin
 Result:=0;
 if IsMainThread then
 if Assigned(Self) then
 try
  ms:=IntMsecNow;
  aTimeout:=NetStatTimeout;
  cmd:=''; ans:=''; tab:='';
  if (aTimeout<=0) then aTimeout:=5000;
  if ArgLsif(cmd,ans) or CallLsif(cmd,ans,aTimeout) then begin
   if StartsText('Error: ',ans) then begin
    LsifTab:=ans;
    Exit;
   end;
   if (WordCount(cmd,ScanSpaces)=1)
   then exe:=ExtractFileName(cmd) else exe:=cmd;
   if IsEmptyStr(file_which(exe)) then exe:=cmd;
   head:=Format('%s => %s',[StdDateTimeStr(ms),exe])+EOL;
   head+=FormatLsifLine('Interface','Type','IP-Address','MAC-Address','OpState','Carrier')+EOL;
   for i:=1 to WordCount(ans,EolnDelims) do begin
    line:=ExtractWord(i,ans,EolnDelims);
    ifs:=ExtractWord(1,line,ScanSpaces);
    typ:=ExtractWord(2,line,ScanSpaces);
    ipa:=ExtractWord(3,line,ScanSpaces);
    if IsEmptyStr(ipa) then continue;
    if not IsLexeme(ifs,lex_Name) then continue;
    if WordIndex(typ,'virtual,physical',ScanSpaces)=0 then continue;
    mac:=TrimDef(StringFromFile(Format('/sys/class/net/%s/address',[ifs]),0),'?');
    ops:=TrimDef(StringFromFile(Format('/sys/class/net/%s/operstate',[ifs]),0),'?');
    car:=TrimDef(StringFromFile(Format('/sys/class/net/%s/carrier',[ifs]),0),'?');
    if SameText(ifs,'lo') and (car='1') and SameText(ops,'unknown') then ops:='up';
    tab+=FormatLsifLine(ifs,typ,ipa,mac,ops,car)+EOL;
   end;
   dirs:=FindAllDirectories('/sys/class/net',False);
   if Assigned(dirs) then
   try
    for i:=0 to dirs.Count-1 do begin
     ifs:=ExtractFileName(dirs[i]); typ:='?'; ipa:='?';
     if (WordIndex(ifs,tab,ScanSpaces)>0) then continue;
     mac:=TrimDef(StringFromFile(Format('/sys/class/net/%s/address',[ifs]),0),'?');
     ops:=TrimDef(StringFromFile(Format('/sys/class/net/%s/operstate',[ifs]),0),'?');
     car:=TrimDef(StringFromFile(Format('/sys/class/net/%s/carrier',[ifs]),0),'?');
     if SameText(ifs,'lo') and (car='1') and SameText(ops,'unknown') then ops:='up';
     tab+=FormatLsifLine(ifs,typ,ipa,mac,ops,car)+EOL;
    end;
   finally
    Kill(dirs);
   end;
   if (tab<>'') then tab:=head+tab;
   LsifTab:=tab;
  end;
 except
  on E:Exception do BugReport(E,Self,'RefreshLsif');
 end;
end;

class function TIanaPortManager.CallLsif(out cmd,ans:LongString; aTimeout:Integer=0):Boolean;
const NetStatFallback=1000; var ms:QWord;
begin
 Result:=False;
 cmd:=''; ans:=''; ms:=GetTickCount64;
 if (aTimeout<=0) then aTimeout:=NetStatTimeout;
 if (aTimeout<=0) then aTimeout:=NetStatFallback;
 if IsUnix then begin
  cmd:=TrimDef(file_which('lsif'),'unix lsif');
  if RunCommandEx(cmd,ans,swoNone,aTimeout,1) then begin
   DebugLog(dlc_IanaLog,Format('Exec %s takes %d ms',[cmd,GetTickCount64-ms]));
   Exit(True);
  end;
  ans:='Error: could not call lsif.';
  DebugLog(dlc_IanaBug,'Failed call of lsif.');
  cmd:=''; ans:='';
 end;
 if IsWindows then begin
  ans:='Error: lsif is not avail on Windows.';
 end;
end;

class function TIanaPortManager.CallNetStat(out cmd,ans:LongString; aTimeout:Integer=0):Boolean;
const NetStatFallback=1000; var ms:QWord;
begin
 Result:=False;
 cmd:=''; ans:=''; ms:=GetTickCount64;
 if (aTimeout<=0) then aTimeout:=NetStatTimeout;
 if (aTimeout<=0) then aTimeout:=NetStatFallback;
 if IsUnix then begin
  if FileIsExecutable(file_which('netstat')) then begin
   cmd:='sudo -n netstat -tuan4p'; ans:='';
   if RunCommandEx(cmd,ans,swoNone,aTimeout,1) then begin
    DebugLog(dlc_IanaLog,Format('Exec %s takes %d ms',[cmd,GetTickCount64-ms]));
    Exit(True);
   end;
   cmd:='netstat -tuan4p'; ans:='';
   if RunCommandEx(cmd,ans,swoNone,aTimeout,1) then begin
    DebugLog(dlc_IanaLog,Format('Exec %s takes %d ms',[cmd,GetTickCount64-ms]));
    Exit(True);
   end;
   DebugLog(dlc_IanaBug,'Failed call of netstat.');
   cmd:=''; ans:='';
  end else DebugLog(dlc_IanaBug,'Command not found (netstat).');
 end;
 if IsWindows then begin
  if FileIsExecutable(file_which('netstat.exe')) then begin
   cmd:='netstat -nao'; ans:='';
   if RunCommandEx(cmd,ans,swoHide,aTimeout,1) then begin
    DebugLog(dlc_IanaLog,Format('Exec %s takes %d ms',[cmd,GetTickCount64-ms]));
    Exit(True);
   end;
   DebugLog(dlc_IanaBug,'Failed call of netstat.');
   cmd:=''; ans:='';
  end else DebugLog(dlc_IanaBug,'Command not found (netstat).');
 end;
end;

class function TIanaPortManager.FormatNetTabRow(const Prot,LAddr,LPort,RAddr,RPort,Stat,sPid:LongString):LongString;
begin
 Result:=Format('%-4s   %-15s   %-5s   %-15s   %-5s   %-11s   %-10s',
               [Prot,LAddr,LPort,RAddr,RPort,Stat,sPid]);
end;

function TIanaPortManager.ParseNetStat(const ans:LongString; out buf:LongString):Integer;
const StatPrefixes4='ESTA,LIST,CLOS,LAST,TIME,SYN_,SYN-,FIN_,FIN-,CONN,UNCO,UNKN';
var Port,wc,i:Integer; wi,Prot,LAddr,LPort,RAddr,RPort,Stat,sPid:LongString;
var Lines:TStringList; Line:LongString; il:Integer;
var Pid:TPid; pf:TIanaPortFlag;
begin
 Result:=0; buf:='';
 if Assigned(Self) then
 try
  Lines:=TStringList.Create;
  try
   Lines.Text:=ans;
   for il:=0 to Lines.Count-1 do begin
    Line:=Lines[il];
    if IsEmptyStr(Line) then continue;
    Pid:=0; sPid:=''; Stat:='';
    LPort:=''; RPort:=''; LAddr:=''; RAddr:='';
    Prot:=ExtractWord(1,Line,ScanSpaces);
    if (WordIndex(Prot,'TCP,UDP',ScanSpaces)>0) then begin
     wc:=WordCount(Line,JustSpaces);
     for i:=2 to wc do begin
      wi:=ExtractWord(i,Line,JustSpaces);
      if (i=wc) or (Pos('/',wi)>0) then begin
       if (Pos('/',wi)>0)
       then Pid:=StrToIntDef(StrAheadOf(wi,'/'),0)
       else Pid:=StrToIntDef(wi,0);
       sPid:=ExtractWord(1,wi,JustSpaces+[':']);
       break;
      end;
      if IsLexeme(wi,lex_Name) then begin
       if (WordIndex(LeftStr(wi,4),StatPrefixes4,ScanSpaces)>0)
       then Stat:=wi;
      end;
      if (CountChars(wi,[':'])=1) then begin
       Port:=StrToIntDef(StrAfterOf(wi,':'),0);
       if (Port>0) and (LPort='') then begin
        LAddr:=StrAheadOf(wi,':');
        LPort:=StrAfterOf(wi,':');
       end else
       if (LPort<>'') then begin
        RAddr:=StrAheadOf(wi,':');
        RPort:=StrAfterOf(wi,':');
       end;
      end;
     end;
     if IsWindows and IsLexeme(sPid,lex_Digit) and Assigned(myPidList) then begin
      i:=myPidList.IndexOfPid(Pid);
      if (i>=0) then sPid:=sPid+'/'+myPidList.TaskName[i];
     end;
     if IsEmptyStr(LPort) then continue;
     if IsEmptyStr(RPort) then continue;
     if IsEmptyStr(LAddr) then continue;
     if IsEmptyStr(RAddr) then continue;
     Port:=StrToIntDef(LPort,0); pf:=0;
     if ValidPortNumber(Port) then begin
      if IsSameText(Prot,'UDP')
      then Stat:=TrimDef(Stat,'LISTEN')
      else Stat:=TrimDef(Stat,'?');
      case WordIndex(LeftStr(Stat,4),StatPrefixes4,ScanSpaces) of
       1:     pf:=ipf_Establ;
       2..11: pf:=ipf_Listen;
       else  pf:=0;
      end;
      if (pf<>0) and (Pid<>GetCurrentProcessId) then PortFlagsOr(Port,pf);
      buf+=FormatNetTabRow(Prot,LAddr,LPort,RAddr,RPort,Stat,sPid)+EOL;
     end;
    end;
   end;
   Result:=WordCount(buf,EolnDelims);
   myPortStat.Listening:=CountPortsWithFlag(ipf_Listen);
   myPortStat.Established:=CountPortsWithFlag(ipf_Establ);
  finally
   Kill(Lines);
  end;
 except
  on E:Exception do BugReport(E,Self,'ParseNetStat');
 end;
end;

function TIanaPortManager.RefreshNetStat(const aCmd:LongString=''; const aAns:LongString=''):Integer;
var cmd,ans,buf,head:LongString; ms:Int64;
 function ArgNetStat(out c,a:LongString):Boolean;
 begin
  Result:=False; c:=''; a:='';
  if IsNonEmptyStr(aCmd) then begin
   c:=aCmd; a:=aAns;
   Result:=True;
  end;
 end;
begin
 Result:=0;
 if IsMainThread then
 if Assigned(Self) then
 try
  ms:=IntMSecNow;
  cmd:=''; ans:=''; buf:='';
  if ArgNetStat(cmd,ans) or CallNetStat(cmd,ans) then begin
   head:=Format('%s => %s',[StdDateTimeStr(ms),cmd])+EOL;
   head+=FormatNetTabRow('PROT','LOCAL_ADDRESS','LPORT',
                         'REMOTE_ADDRESS','RPORT','STATE','PID/TASK_NAME')+EOL;
   if Assigned(myPidList) then myPidList.RefreshProcessList;
   Result:=ParseNetStat(ans,buf);
   buf:=head+buf;
   NetTab:=buf;
  end;
 except
  on E:Exception do BugReport(E,Self,'RefreshNetStat');
 end;
end;

function TIanaPortManager.FetchNetStatTable(aRefresh:Boolean=False):LongString;
begin
 Result:='';
 if Assigned(Self) then begin
  if aRefresh then RefreshNetStat;
  Result:=NetTab;
 end;
end;

/////////////////////////
// IanaMan implementation
/////////////////////////

const
 TheIanaMan:TIanaPortManager=nil;

function IanaMan:TIanaPortManager;
begin
 if not Assigned(TheIanaMan) then begin
  TheIanaMan:=TIanaPortManager.Create;
  TheIanaMan.Master:=@TheIanaMan;
 end;
 Result:=TheIanaMan;
end;

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

procedure Init_crw_iana;
begin
 dlc_IanaLog; dlc_IanaBug;
 if IanaMan.Ok then IanaMan.NetStatTimeout:=5000;
end;

procedure Free_crw_iana;
begin
 Kill(TObject(TheIanaMan));
end;

initialization

 Init_crw_iana;

finalization

 Free_crw_iana;

end.

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

