comet/comet.pas

{
  Comet - Direct TCP File Transfer for FidoNet
  comet.pas - Main program

  Usage:
    comet                   Run as daemon (listen + poll outbound)
    comet -c config.cfg     Use specified config file
    comet call 1:213/723    Single outbound call to a node
    comet -h                Show help
    comet -v                Show version

  Signal handling (Unix):
    SIGHUP  = Reload configuration
    SIGTERM = Clean shutdown
    SIGINT  = Clean shutdown

  Copyright (C) 2026 Ken Johnson
  License: GPL-2.0
}
program comet;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}
  BaseUnix,
  {$ENDIF}
  SysUtils, Classes, cometdef, cometcfg, cometpath, comettcp, cometlog,
  cometses, cometxfer, cometbso, cometbinkp, cometfile, cometdaemon;

const
  DEFAULT_CFG = 'comet.cfg';

var
  Daemon: TCometDaemon;
  CfgPath: string;
  CmdMode: (cmDaemon, cmCall, cmHelp, cmVersion);
  CallTarget: string;

{$IFDEF UNIX}
{ Signal handlers }
procedure HandleSigTerm(Sig: cint); cdecl;
begin
  if Daemon <> nil then
    Daemon.Shutdown;
end;

procedure HandleSigHup(Sig: cint); cdecl;
begin
  LogInfo('SIGHUP received - config reload not yet implemented');
end;

procedure InstallSignalHandlers;
var
  Act: SigActionRec;
begin
  FillChar(Act, SizeOf(Act), 0);
  Act.sa_handler := SigActionHandler(@HandleSigTerm);
  fpSigAction(SIGTERM, @Act, nil);
  fpSigAction(SIGINT, @Act, nil);

  Act.sa_handler := SigActionHandler(@HandleSigHup);
  fpSigAction(SIGHUP, @Act, nil);

  { Ignore SIGPIPE - critical for TCP code }
  Act.sa_handler := SigActionHandler(SIG_IGN);
  fpSigAction(SIGPIPE, @Act, nil);
end;
{$ENDIF}


procedure ShowVersion;
begin
  WriteLn(COMET_NAME, ' ', COMET_VERSION,
    ' - Direct TCP File Transfer for FidoNet');
  WriteLn('Copyright (C) 2026 Ken Johnson');
  WriteLn('Port 26638 (C-O-M-E-T) with BinkP fallback');
end;

procedure ShowHelp;
begin
  ShowVersion;
  WriteLn;
  WriteLn('Usage: comet [options] [command]');
  WriteLn;
  WriteLn('Commands:');
  WriteLn('  (none)                 Run as daemon (listen + poll outbound)');
  WriteLn('  call <address>         Single outbound call to a FidoNet node');
  WriteLn('                         Address format: zone:net/node[.point]');
  WriteLn;
  WriteLn('Options:');
  WriteLn('  -c <file>              Use specified config file');
  WriteLn('                         (default: comet.cfg in current directory)');
  WriteLn('  -d                     Enable debug/trace logging');
  WriteLn('  -q                     Quiet mode (errors only on console)');
  WriteLn('  -v                     Show version and exit');
  WriteLn('  -h, --help             Show this help and exit');
  WriteLn;
  WriteLn('Signals (Unix):');
  WriteLn('  SIGHUP                 Reload configuration');
  WriteLn('  SIGTERM, SIGINT        Clean shutdown');
  WriteLn;
  WriteLn('Configuration:');
  WriteLn('  Edit comet.cfg or run CSETUP for interactive configuration.');
  WriteLn('  See COMET.DOC for complete documentation of all options.');
  WriteLn;
  WriteLn('Supported outbound formats:');
  WriteLn('  BSO (Binkley-Style Outbound) - primary');
  WriteLn('  FrontDoor .MSG style');
  WriteLn('  D''Bridge Q-file queue');
  WriteLn;
  WriteLn('Report bugs: https://github.com/kenj/comet/issues');
end;


procedure ParseArgs;
var
  I: Integer;
  Arg: string;
begin
  CfgPath := DEFAULT_CFG;
  CmdMode := cmDaemon;
  CallTarget := '';

  I := 1;
  while I <= ParamCount do
  begin
    Arg := ParamStr(I);

    if (Arg = '-h') or (Arg = '--help') then
    begin
      CmdMode := cmHelp;
      Exit;
    end
    else if Arg = '-v' then
    begin
      CmdMode := cmVersion;
      Exit;
    end
    else if Arg = '-c' then
    begin
      Inc(I);
      if I <= ParamCount then
        CfgPath := ParamStr(I)
      else
      begin
        WriteLn('Error: -c requires a filename argument');
        Halt(1);
      end;
    end
    else if Arg = '-d' then
    begin
      CometLogSetDebug(True);
      CometLogSetConsoleLevel(cllDebug);
    end
    else if Arg = '-q' then
    begin
      CometLogSetConsoleLevel(cllError);
    end
    else if Arg = 'call' then
    begin
      CmdMode := cmCall;
      Inc(I);
      if I <= ParamCount then
        CallTarget := ParamStr(I)
      else
      begin
        WriteLn('Error: call requires a FidoNet address (e.g., 1:213/723)');
        Halt(1);
      end;
    end
    else
    begin
      WriteLn('Error: Unknown option: ', Arg);
      WriteLn('Try: comet -h');
      Halt(1);
    end;

    Inc(I);
  end;
end;


procedure RunDaemon;
begin
  Daemon := TCometDaemon.Create;
  try
    if not Daemon.LoadConfig(CfgPath) then
    begin
      LogFatal('Cannot load config: %s', [CfgPath]);
      LogFatal('Run CSETUP to create a configuration, or copy COMET.SAM to comet.cfg');
      Exit;
    end;

    {$IFDEF UNIX}
    InstallSignalHandlers;
    {$ENDIF}

    Daemon.Run;
  finally
    Daemon.Free;
    Daemon := nil;
  end;
end;


procedure RunCall;
var
  Addr: TCometAddress;
  Cfg: TCometConfig;
  NodeIdx: Integer;
  Sock: TCometSocket;
  Host: string;
  Port, BinkpPort: Word;
  State: TCometSessionState;
  XS: TCometXferState;
  HSResult: TCometHandshakeResult;
  UseComet: Boolean;
  Flav: TCometFlavour;
  FloPath, PktPath, InDir: string;
  FloEntries: TCometFloEntryArray;
  I, XResult: Integer;
  BResult: TCometBinkpResult;
  SendFiles: TStringList;
  TF: file;
  {$IFDEF UNIX}
  Act: SigActionRec;
  {$ENDIF}
begin
  if not CometStrToAddr(CallTarget, Addr) then
  begin
    WriteLn('Error: Invalid FidoNet address: ', CallTarget);
    Halt(1);
  end;

  { Load config }
  if not CometCfgLoad(CfgPath, Cfg) then
  begin
    WriteLn('Error: Cannot load config: ', CfgPath);
    Halt(1);
  end;
  CometCfgApply(Cfg);

  { Find node config for host/port }
  NodeIdx := CometCfgFindNode(Cfg, Addr);
  if NodeIdx < 0 then
  begin
    WriteLn('Error: No host configured for ', CometAddrToStr(Addr));
    WriteLn('Add a [Node:', CometAddrToStr(Addr), '] section to ', CfgPath);
    Halt(1);
  end;

  Host := Cfg.Nodes[NodeIdx].Host;
  Port := Cfg.Nodes[NodeIdx].Port;
  if Port = 0 then Port := COMET_PORT;
  BinkpPort := Cfg.Nodes[NodeIdx].BinkpPort;
  if BinkpPort = 0 then BinkpPort := Cfg.BinkpPort;
  UseComet := not Cfg.Nodes[NodeIdx].NoComet;

  if Host = '' then
  begin
    WriteLn('Error: No host/IP configured for ', CometAddrToStr(Addr));
    Halt(1);
  end;

  {$IFDEF UNIX}
  { Ignore SIGPIPE - critical for TCP }
  FillChar(Act, SizeOf(Act), 0);
  Act.sa_handler := SigActionHandler(SIG_IGN);
  fpSigAction(SIGPIPE, @Act, nil);
  {$ENDIF}

  { Determine inbound directory }
  if Cfg.SecInbound <> '' then
    InDir := Cfg.SecInbound
  else
    InDir := Cfg.Inbound;

  { Ensure directories exist }
  CometMakePath(InDir);
  if Cfg.TempDir <> '' then CometMakePath(Cfg.TempDir);

  { Try Comet first, then BinkP fallback }
  Sock := COMET_TCP_INVALID;

  if UseComet then
  begin
    LogInfo('Calling %s at %s:%d (Comet)', [CometAddrToStr(Addr), Host, Port]);
    Sock := CometTcpConnect(Host, Port, 15000);
  end;

  if (Sock = COMET_TCP_INVALID) and Cfg.BinkpEnabled then
  begin
    if UseComet then
      LogInfo('Comet connect failed, trying BinkP on port %d', [BinkpPort])
    else
      LogInfo('Calling %s at %s:%d (BinkP)', [CometAddrToStr(Addr), Host, BinkpPort]);
    Sock := CometTcpConnect(Host, BinkpPort, 15000);
    if Sock <> COMET_TCP_INVALID then
      UseComet := False;
  end;

  if Sock = COMET_TCP_INVALID then
  begin
    LogError('Cannot connect to %s', [CometAddrToStr(Addr)]);
    Halt(1);
  end;

  if UseComet then
  begin
    { ---- Comet protocol session ---- }
    CometSessionInit(State, Sock, True, Host, Port);
    try
      State.OurInit.Password := CometCfgGetPassword(Cfg, Addr);
      HSResult := CometHandshake(State, Cfg);
      if HSResult <> chrOK then
      begin
        LogError('Handshake failed: %d', [Ord(HSResult)]);
        CometTcpClose(Sock);
        Halt(1);
      end;

      CometXferInit(XS, State, InDir, Cfg.TempDir,
        CometAddSlash(Cfg.TempDir) + 'comet-abort.log');
      try
        { Send .?UT packet files }
        for Flav := Low(TCometFlavour) to High(TCometFlavour) do
        begin
          if Flav = cfHold then Continue;
          PktPath := BSONodeFile(Cfg.Outbound, Addr,
            Cfg.Addresses[0].Zone, BSOPktExt(Flav));
          if CometFileExists(PktPath) then
          begin
            XResult := CometTransfer(XS, PktPath, '');
            if XResult = XFER_ABORT then Break;
            if XResult = XFER_OK then
              DeleteFile(PktPath);
          end;
        end;

        { Send files from .FLO flow files }
        for Flav := Low(TCometFlavour) to High(TCometFlavour) do
        begin
          if Flav = cfHold then Continue;
          FloPath := BSONodeFile(Cfg.Outbound, Addr,
            Cfg.Addresses[0].Zone, BSOFloExt(Flav));
          if not CometFileExists(FloPath) then Continue;

          FloEntries := BSOReadFlo(FloPath);
          for I := 0 to High(FloEntries) do
          begin
            if FloEntries[I].Sent then Continue;
            if FloEntries[I].FilePath = '' then Continue;
            if not FileExists(FloEntries[I].FilePath) then Continue;

            XResult := CometTransfer(XS, FloEntries[I].FilePath, '');
            if XResult = XFER_ABORT then Break;
            if XResult = XFER_OK then
            begin
              case FloEntries[I].Action of
                csaDelete:
                  DeleteFile(FloEntries[I].FilePath);
                csaTruncate:
                begin
                  AssignFile(TF, FloEntries[I].FilePath);
                  {$I-} Rewrite(TF, 1); {$I+}
                  if IOResult = 0 then CloseFile(TF);
                end;
              end;
              BSOMarkSent(FloPath, FloEntries[I].OrigPath);
            end;
          end;
          BSOCleanFlo(FloPath);
        end;

        { End of batch - also receives any remaining files from remote }
        CometTransfer(XS, '', '');

        LogInfo('Session complete: sent %d files (%s), rcvd %d files (%s)',
          [XS.FilesSent, CometFormatSize(XS.BytesSent),
           XS.FilesRecvd, CometFormatSize(XS.BytesRecvd)]);
      finally
        CometXferDone(XS);
      end;
    finally
      CometSessionDone(State);
      CometTcpClose(Sock);
    end;
  end
  else
  begin
    { ---- BinkP fallback session ---- }
    SendFiles := TStringList.Create;
    try
      { Build file list from BSO outbound }
      for Flav := Low(TCometFlavour) to High(TCometFlavour) do
      begin
        if Flav = cfHold then Continue;
        PktPath := BSONodeFile(Cfg.Outbound, Addr,
          Cfg.Addresses[0].Zone, BSOPktExt(Flav));
        if CometFileExists(PktPath) then
          SendFiles.Add(PktPath);

        FloPath := BSONodeFile(Cfg.Outbound, Addr,
          Cfg.Addresses[0].Zone, BSOFloExt(Flav));
        if CometFileExists(FloPath) then
        begin
          FloEntries := BSOReadFlo(FloPath);
          for I := 0 to High(FloEntries) do
            if not FloEntries[I].Sent and (FloEntries[I].FilePath <> '') and
               FileExists(FloEntries[I].FilePath) then
              SendFiles.Add(FloEntries[I].FilePath);
        end;
      end;

      BResult := BinkpRunOutbound(Sock, Cfg, Addr,
        InDir, Cfg.TempDir, SendFiles);

      if BResult.Success then
      begin
        { Clean up outbound }
        for Flav := Low(TCometFlavour) to High(TCometFlavour) do
        begin
          if Flav = cfHold then Continue;
          PktPath := BSONodeFile(Cfg.Outbound, Addr,
            Cfg.Addresses[0].Zone, BSOPktExt(Flav));
          if FileExists(PktPath) then DeleteFile(PktPath);
          FloPath := BSONodeFile(Cfg.Outbound, Addr,
            Cfg.Addresses[0].Zone, BSOFloExt(Flav));
          if FileExists(FloPath) then BSOCleanFlo(FloPath);
        end;

        LogInfo('BinkP session complete: sent %d files (%s), rcvd %d files (%s)',
          [BResult.FilesSent, CometFormatSize(BResult.BytesSent),
           BResult.FilesRecvd, CometFormatSize(BResult.BytesRecvd)]);
      end
      else
        LogError('BinkP session failed: %s', [BResult.ErrorMsg]);
    finally
      SendFiles.Free;
      CometTcpClose(Sock);
    end;
  end;
end;


{ ---- Entry point ---- }

begin
  Daemon := nil;
  CometLogSetConsole(True);
  CometLogSetConsoleTimestamp(False);

  ParseArgs;

  case CmdMode of
    cmHelp:    ShowHelp;
    cmVersion: ShowVersion;
    cmDaemon:  RunDaemon;
    cmCall:    RunCall;
  end;
end.