comet/cometlog.pas

{
  Comet - Direct TCP File Transfer for FidoNet
  cometlog.pas - Logging subsystem

  Supports simultaneous output to:
  - Log file (with timestamps, rotatable)
  - Console (stdout, with optional color)
  - Debug file (verbose protocol-level trace)

  Log levels: Fatal, Error, Warning, Info, Debug
  Each output target has its own minimum level filter.

  Log format (file):
    2026-03-29 14:30:05  + Connecting to 1:213/723
    2026-03-29 14:30:06  ! Connection refused
    2026-03-29 14:30:06  * Falling back to BinkP

  Prefix characters by level:
    !  Fatal/Error
    #  Warning
    +  Info
    *  Debug

  Thread-safe: all writes go through a critical section.

  Copyright (C) 2026 Ken Johnson
  License: GPL-2.0
}
unit cometlog;

{$mode objfpc}{$H+}

interface

uses
  SysUtils;

type
  TCometLogLevel = (
    cllDebug   = 0,
    cllInfo    = 1,
    cllWarning = 2,
    cllError   = 3,
    cllFatal   = 4
  );

const
  { Level names for display }
  CometLogLevelName: array[TCometLogLevel] of string = (
    'DEBUG', 'INFO', 'WARN', 'ERROR', 'FATAL'
  );

  { Prefix chars for log file lines }
  CometLogLevelPrefix: array[TCometLogLevel] of Char = (
    '*', '+', '#', '!', '!'
  );


{ ---- Initialization ---- }

{ Open the log file. Path is the full path to the log file.
  Appends if file exists. Creates parent directories if needed. }
procedure CometLogOpen(const LogPath: string);

{ Open a separate debug log file for protocol-level tracing.
  Only written to when debug logging is enabled. }
procedure CometLogOpenDebug(const DebugPath: string);

{ Close all log files }
procedure CometLogClose;


{ ---- Configuration ---- }

{ Set minimum log level for file output (default: cllInfo) }
procedure CometLogSetFileLevel(Level: TCometLogLevel);

{ Set minimum log level for console output (default: cllInfo) }
procedure CometLogSetConsoleLevel(Level: TCometLogLevel);

{ Enable/disable debug log (default: disabled) }
procedure CometLogSetDebug(Enabled: Boolean);

{ Enable/disable console output (default: enabled) }
procedure CometLogSetConsole(Enabled: Boolean);

{ Enable/disable timestamps in console output (default: disabled) }
procedure CometLogSetConsoleTimestamp(Enabled: Boolean);


{ ---- Logging ---- }

{ Log a message at the specified level }
procedure CometLog(Level: TCometLogLevel; const Msg: string);
procedure CometLog(Level: TCometLogLevel; const Fmt: string; const Args: array of const);

{ Convenience wrappers }
procedure LogDebug(const Msg: string);
procedure LogDebug(const Fmt: string; const Args: array of const);
procedure LogInfo(const Msg: string);
procedure LogInfo(const Fmt: string; const Args: array of const);
procedure LogWarning(const Msg: string);
procedure LogWarning(const Fmt: string; const Args: array of const);
procedure LogError(const Msg: string);
procedure LogError(const Fmt: string; const Args: array of const);
procedure LogFatal(const Msg: string);
procedure LogFatal(const Fmt: string; const Args: array of const);

{ Write to debug log only (protocol trace, hex dumps, etc.).
  Only written if debug logging is enabled. }
procedure LogTrace(const Msg: string);
procedure LogTrace(const Fmt: string; const Args: array of const);

{ Log a hex dump of a buffer to the debug log }
procedure LogTraceHex(const Label_: string; Data: PByte; Len: LongInt);


implementation

var
  LogFile:       TextFile;
  LogFileOpen:   Boolean = False;
  LogFilePath:   string = '';

  DebugFile:     TextFile;
  DebugFileOpen: Boolean = False;
  DebugFilePath: string = '';

  FileLevel:     TCometLogLevel = cllInfo;
  ConsoleLevel:  TCometLogLevel = cllInfo;
  DebugEnabled:  Boolean = False;
  ConsoleOn:     Boolean = True;
  ConsoleTS:     Boolean = False;

  LogLock:       TRTLCriticalSection;
  LogInited:     Boolean = False;


procedure EnsureInit;
begin
  if LogInited then Exit;
  InitCriticalSection(LogLock);
  LogInited := True;
end;


function LogTimestamp: string;
var
  Now: TDateTime;
  Y, M, D, HH, MM, SS, MS: Word;
begin
  Now := SysUtils.Now;
  DecodeDate(Now, Y, M, D);
  DecodeTime(Now, HH, MM, SS, MS);
  Result := Format('%04d-%02d-%02d %02d:%02d:%02d', [Y, M, D, HH, MM, SS]);
end;


{ ---- Initialization ---- }

procedure CometLogOpen(const LogPath: string);
begin
  EnsureInit;
  EnterCriticalSection(LogLock);
  try
    if LogFileOpen then
    begin
      CloseFile(LogFile);
      LogFileOpen := False;
    end;

    LogFilePath := LogPath;
    if LogFilePath = '' then Exit;

    { Create parent directory if needed }
    ForceDirectories(ExtractFilePath(LogFilePath));

    AssignFile(LogFile, LogFilePath);
    {$I-}
    if FileExists(LogFilePath) then
      Append(LogFile)
    else
      Rewrite(LogFile);
    {$I+}

    if IOResult = 0 then
    begin
      LogFileOpen := True;
      WriteLn(LogFile, '');
      WriteLn(LogFile, LogTimestamp, '  + Comet log opened');
      Flush(LogFile);
    end;
  finally
    LeaveCriticalSection(LogLock);
  end;
end;


procedure CometLogOpenDebug(const DebugPath: string);
begin
  EnsureInit;
  EnterCriticalSection(LogLock);
  try
    if DebugFileOpen then
    begin
      CloseFile(DebugFile);
      DebugFileOpen := False;
    end;

    DebugFilePath := DebugPath;
    if DebugFilePath = '' then Exit;

    ForceDirectories(ExtractFilePath(DebugFilePath));

    AssignFile(DebugFile, DebugFilePath);
    {$I-}
    if FileExists(DebugFilePath) then
      Append(DebugFile)
    else
      Rewrite(DebugFile);
    {$I+}

    if IOResult = 0 then
    begin
      DebugFileOpen := True;
      WriteLn(DebugFile, '');
      WriteLn(DebugFile, '=== Comet debug session started ', LogTimestamp, ' ===');
      Flush(DebugFile);
    end;
  finally
    LeaveCriticalSection(LogLock);
  end;
end;


procedure CometLogClose;
begin
  if not LogInited then Exit;
  EnterCriticalSection(LogLock);
  try
    if LogFileOpen then
    begin
      WriteLn(LogFile, LogTimestamp, '  + Comet log closed');
      CloseFile(LogFile);
      LogFileOpen := False;
    end;

    if DebugFileOpen then
    begin
      WriteLn(DebugFile, '=== Comet debug session ended ', LogTimestamp, ' ===');
      CloseFile(DebugFile);
      DebugFileOpen := False;
    end;
  finally
    LeaveCriticalSection(LogLock);
  end;
end;


{ ---- Configuration ---- }

procedure CometLogSetFileLevel(Level: TCometLogLevel);
begin
  FileLevel := Level;
end;

procedure CometLogSetConsoleLevel(Level: TCometLogLevel);
begin
  ConsoleLevel := Level;
end;

procedure CometLogSetDebug(Enabled: Boolean);
begin
  DebugEnabled := Enabled;
end;

procedure CometLogSetConsole(Enabled: Boolean);
begin
  ConsoleOn := Enabled;
end;

procedure CometLogSetConsoleTimestamp(Enabled: Boolean);
begin
  ConsoleTS := Enabled;
end;


{ ---- Core logging ---- }

procedure CometLog(Level: TCometLogLevel; const Msg: string);
var
  TS: string;
  Prefix: Char;
  Line: string;
begin
  EnsureInit;
  Prefix := CometLogLevelPrefix[Level];
  TS := LogTimestamp;
  Line := TS + '  ' + Prefix + ' ' + Msg;

  EnterCriticalSection(LogLock);
  try
    { Write to log file }
    if LogFileOpen and (Level >= FileLevel) then
    begin
      WriteLn(LogFile, Line);
      Flush(LogFile);
    end;

    { Write to console }
    if ConsoleOn and (Level >= ConsoleLevel) then
    begin
      if ConsoleTS then
        WriteLn(Line)
      else
        WriteLn(Prefix, ' ', Msg);
    end;

    { Write to debug log if enabled }
    if DebugFileOpen and DebugEnabled then
    begin
      WriteLn(DebugFile, Line);
      Flush(DebugFile);
    end;
  finally
    LeaveCriticalSection(LogLock);
  end;
end;

procedure CometLog(Level: TCometLogLevel; const Fmt: string; const Args: array of const);
begin
  CometLog(Level, Format(Fmt, Args));
end;


{ ---- Convenience wrappers ---- }

procedure LogDebug(const Msg: string);
begin
  CometLog(cllDebug, Msg);
end;

procedure LogDebug(const Fmt: string; const Args: array of const);
begin
  CometLog(cllDebug, Fmt, Args);
end;

procedure LogInfo(const Msg: string);
begin
  CometLog(cllInfo, Msg);
end;

procedure LogInfo(const Fmt: string; const Args: array of const);
begin
  CometLog(cllInfo, Fmt, Args);
end;

procedure LogWarning(const Msg: string);
begin
  CometLog(cllWarning, Msg);
end;

procedure LogWarning(const Fmt: string; const Args: array of const);
begin
  CometLog(cllWarning, Fmt, Args);
end;

procedure LogError(const Msg: string);
begin
  CometLog(cllError, Msg);
end;

procedure LogError(const Fmt: string; const Args: array of const);
begin
  CometLog(cllError, Fmt, Args);
end;

procedure LogFatal(const Msg: string);
begin
  CometLog(cllFatal, Msg);
end;

procedure LogFatal(const Fmt: string; const Args: array of const);
begin
  CometLog(cllFatal, Fmt, Args);
end;


{ ---- Debug trace ---- }

procedure LogTrace(const Msg: string);
begin
  if not DebugEnabled then Exit;
  EnsureInit;
  EnterCriticalSection(LogLock);
  try
    if DebugFileOpen then
    begin
      WriteLn(DebugFile, LogTimestamp, '  ', Msg);
      Flush(DebugFile);
    end;
  finally
    LeaveCriticalSection(LogLock);
  end;
end;

procedure LogTrace(const Fmt: string; const Args: array of const);
begin
  if not DebugEnabled then Exit;
  LogTrace(Format(Fmt, Args));
end;

procedure LogTraceHex(const Label_: string; Data: PByte; Len: LongInt);
var
  I: LongInt;
  Line: string;
  MaxDump: LongInt;
begin
  if not DebugEnabled then Exit;
  if not DebugFileOpen then Exit;

  EnsureInit;
  EnterCriticalSection(LogLock);
  try
    WriteLn(DebugFile, LogTimestamp, '  ', Label_, ' (', Len, ' bytes):');

    MaxDump := Len;
    if MaxDump > 256 then MaxDump := 256;

    Line := '';
    I := 0;
    while I < MaxDump do
    begin
      if (I mod 16) = 0 then
      begin
        if I > 0 then WriteLn(DebugFile, Line);
        Line := Format('  %04X: ', [I]);
      end;

      Line := Line + Format('%02X ', [Data[I]]);
      Inc(I);
    end;

    if Line <> '' then
      WriteLn(DebugFile, Line);

    if Len > 256 then
      WriteLn(DebugFile, Format('  ... (%d more bytes)', [Len - 256]));

    Flush(DebugFile);
  finally
    LeaveCriticalSection(LogLock);
  end;
end;


{ ---- Cleanup ---- }

finalization
  if LogInited then
  begin
    CometLogClose;
    DoneCriticalSection(LogLock);
  end;

end.