comet/cometses.pas

{
  Comet - Direct TCP File Transfer for FidoNet
  cometses.pas - Session handshake and protocol negotiation

  Comet session flow:
  1. TCP connect on port 26638
  2. Originator sends banner: "COMET/1.0\r\n"
  3. Answerer reads banner:
     - If starts with "COMET" -> respond "COMET/1.0\r\n", proceed to step 4
     - If looks like BinkP frame -> switch to BinkP handler
     - Otherwise -> reject, close
  4. Both sides exchange INIT packets (extended with FidoNet addressing)
  5. Both sides compute negotiated parameters (min of each)
  6. Both sides send INITACK with agreed parameters
  7. Session established -> proceed to file transfer (cometxfer)

  Comet INIT payload (extends Nova INIT with addressing):
    Offset  Size  Field
    0       4     Protocol revision (currently 1)
    4       4     Capability flags (COPT_*)
    8       4     Maximum block size
    12      4     Maximum window size
    16      1     Number of addresses (1-255)
    17      8*N   Addresses: Zone(2)+Net(2)+Node(2)+Point(2) each, LE
    17+8N   var   NUL-terminated password
    ...     var   NUL-terminated system name
    ...     var   NUL-terminated sysop name
    ...     var   NUL-terminated mailer string

  Comet INITACK payload (same as Nova):
    Offset  Size  Field
    0       4     Shared capability flags
    4       4     Agreed max block size
    8       4     Agreed max window size

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

{$mode objfpc}{$H+}

interface

uses
  SysUtils, cometdef, cometcfg, comettcp, cometfrm, cometlog;

const
  COMET_BANNER = 'COMET/1.0' + #13#10;
  COMET_BANNER_LEN = 11;             { Length of banner string              }
  COMET_BANNER_PREFIX = 'COMET';

  { BinkP detection: first byte of a BinkP session is a frame type }
  BINKP_FRAME_MARKER = $80;          { BinkP command frame has high bit    }

type
  { Session handshake result }
  TCometHandshakeResult = (
    chrOK,                           { Handshake succeeded                  }
    chrBinkP,                        { Remote speaks BinkP, not Comet       }
    chrTimeout,                      { Handshake timed out                  }
    chrBadPassword,                  { Password mismatch                    }
    chrProtocolError,                { Invalid data received                }
    chrDisconnect                    { Connection lost during handshake     }
  );

  { Complete session state }
  TCometSessionState = record
    { Connection }
    Sock:          TCometSocket;     { Socket handle                        }
    IsOriginator:  Boolean;          { True = we initiated the connection   }
    RemoteIP:      string;           { Remote IP address                    }
    RemotePort:    Word;             { Remote port number                   }

    { Negotiated parameters }
    Session:       TCometSession;    { Negotiated session from cometdef     }

    { Our info (from config) }
    OurInit:       TCometInitInfo;   { What we sent in INIT                 }

    { Remote info (from their INIT) }
    RemoteInit:    TCometInitInfo;   { What they sent in INIT               }

    { Frame layer }
    FrameRx:       TCometFrameRx;    { Frame receiver context               }

    { Session state }
    Active:        Boolean;          { Session is active                    }
  end;


{ ---- Banner Exchange ---- }

{ Send the COMET banner. Returns True on success. }
function CometSendBanner(Sock: TCometSocket): Boolean;

{ Receive and check the remote banner. Non-blocking reads with timeout.
  Returns chrOK if COMET banner received, chrBinkP if BinkP detected,
  chrTimeout or chrDisconnect on failure. PeekBuf receives any bytes
  read that weren't part of the banner (for BinkP handoff). }
function CometRecvBanner(Sock: TCometSocket; TimeoutSecs: Integer;
  out PeekBuf: string): TCometHandshakeResult;


{ ---- INIT/INITACK Exchange ---- }

{ Build an INIT payload from config and init info. Returns payload bytes. }
function CometBuildInit(const Info: TCometInitInfo): TBytes;

{ Parse a received INIT payload into a TCometInitInfo record. }
function CometParseInit(Payload: PByte; PayLen: LongWord;
  out Info: TCometInitInfo): Boolean;

{ Build an INITACK payload from negotiated session. }
function CometBuildInitAck(const Sess: TCometSession): TBytes;

{ Parse a received INITACK payload. }
function CometParseInitAck(Payload: PByte; PayLen: LongWord;
  out SharedCaps: LongWord; out MaxBlock: LongWord;
  out WindowSize: Word): Boolean;

{ Negotiate session parameters from both sides' INIT info. }
procedure CometNegotiate(const OurInit, RemoteInit: TCometInitInfo;
  const Password: string; out Sess: TCometSession);


{ ---- Full Handshake ---- }

{ Perform complete Comet session handshake.
  For originator: send banner, wait for banner, exchange INIT/INITACK.
  For answerer: banner already validated by caller, exchange INIT/INITACK.
  Fills in State with negotiated session parameters.
  Returns handshake result code. }
function CometHandshake(var State: TCometSessionState;
  const Cfg: TCometConfig): TCometHandshakeResult;

{ Initialize session state. Call before CometHandshake. }
procedure CometSessionInit(var State: TCometSessionState;
  Sock: TCometSocket; IsOriginator: Boolean;
  const RemoteIP: string; RemotePort: Word);

{ Clean up session state. }
procedure CometSessionDone(var State: TCometSessionState);

{ Fill OurInit from config. }
procedure CometBuildOurInit(var State: TCometSessionState;
  const Cfg: TCometConfig);


implementation


{ ---- Little-endian helpers ---- }

procedure PutLE32(Buf: PByte; Val: LongWord);
begin
  Buf[0] := Byte(Val and $FF);
  Buf[1] := Byte((Val shr 8) and $FF);
  Buf[2] := Byte((Val shr 16) and $FF);
  Buf[3] := Byte((Val shr 24) and $FF);
end;

function GetLE32(Buf: PByte): LongWord;
begin
  Result := LongWord(Buf[0]) or
            (LongWord(Buf[1]) shl 8) or
            (LongWord(Buf[2]) shl 16) or
            (LongWord(Buf[3]) shl 24);
end;

procedure PutLE16(Buf: PByte; Val: Word);
begin
  Buf[0] := Byte(Val and $FF);
  Buf[1] := Byte((Val shr 8) and $FF);
end;

function GetLE16(Buf: PByte): Word;
begin
  Result := Word(Buf[0]) or (Word(Buf[1]) shl 8);
end;

{ Write a NUL-terminated string to buffer. Returns bytes written. }
function PutNulStr(Buf: PByte; const S: string): LongWord;
var
  L: LongWord;
begin
  L := Length(S);
  if L > 0 then
    Move(S[1], Buf^, L);
  Buf[L] := 0;
  Result := L + 1;
end;

{ Read a NUL-terminated string from buffer. Advances P past the NUL.
  Returns '' if NUL not found before Limit. }
function GetNulStr(var P: PByte; Limit: PByte): string;
var
  Start: PByte;
begin
  Start := P;
  while (P < Limit) and (P^ <> 0) do
    Inc(P);
  SetLength(Result, P - Start);
  if Length(Result) > 0 then
    Move(Start^, Result[1], Length(Result));
  if P < Limit then
    Inc(P);  { Skip NUL }
end;


{ ---- Banner Exchange ---- }

function CometSendBanner(Sock: TCometSocket): Boolean;
var
  Banner: string;
begin
  Banner := COMET_BANNER;
  Result := CometTcpSendAll(Sock, @Banner[1], Length(Banner));
  if Result then
    LogTrace('TX banner: COMET/1.0');
end;


function CometRecvBanner(Sock: TCometSocket; TimeoutSecs: Integer;
  out PeekBuf: string): TCometHandshakeResult;
var
  Buf: array[0..63] of Byte;
  BufPos: Integer;
  Deadline: LongInt;
  Got: LongInt;
begin
  Result := chrTimeout;
  PeekBuf := '';
  BufPos := 0;
  Deadline := DateTimeToTimeStamp(Now).Time div 1000 + (TimeoutSecs * 1000);

  while BufPos < 64 do
  begin
    if not CometTcpWaitData(Sock, 500) then
    begin
      if DateTimeToTimeStamp(Now).Time div 1000 > Deadline then Exit;
      if not CometTcpConnected(Sock) then
      begin
        Result := chrDisconnect;
        Exit;
      end;
      Continue;
    end;

    Got := CometTcpRecv(Sock, @Buf[BufPos], 1);
    if Got < 0 then
    begin
      Result := chrDisconnect;
      Exit;
    end;
    if Got = 0 then Continue;

    { Check for BinkP on very first byte }
    if (BufPos = 0) and ((Buf[0] and $80) <> 0) then
    begin
      { BinkP command frame detected (high bit set) }
      SetLength(PeekBuf, 1);
      PeekBuf[1] := Char(Buf[0]);
      Result := chrBinkP;
      LogTrace('RX first byte $%02X - BinkP detected', [Buf[0]]);
      Exit;
    end;

    Inc(BufPos);

    { Check for complete banner (ends with \n) }
    if Buf[BufPos - 1] = $0A then
    begin
      { Verify it starts with "COMET" }
      if BufPos >= 5 then
      begin
        if (Buf[0] = Ord('C')) and (Buf[1] = Ord('O')) and
           (Buf[2] = Ord('M')) and (Buf[3] = Ord('E')) and
           (Buf[4] = Ord('T')) then
        begin
          LogTrace('RX banner: COMET (valid)');
          Result := chrOK;
          Exit;
        end;
      end;

      { Got a line but it's not COMET }
      LogTrace('RX banner: not COMET');
      Result := chrProtocolError;
      Exit;
    end;
  end;

  { Buffer full without finding \n }
  Result := chrProtocolError;
end;


{ ---- INIT/INITACK Building ---- }

function CometBuildInit(const Info: TCometInitInfo): TBytes;
var
  Buf: array[0..4095] of Byte;
  Pos: LongWord;
  I: Integer;
begin
  Result := nil;
  Pos := 0;

  { Protocol revision (4 bytes LE) }
  PutLE32(@Buf[Pos], Info.Version); Inc(Pos, 4);

  { Capability flags (4 bytes LE) }
  PutLE32(@Buf[Pos], Info.Caps); Inc(Pos, 4);

  { Max block size (4 bytes LE) }
  PutLE32(@Buf[Pos], Info.MaxBlock); Inc(Pos, 4);

  { Window size (4 bytes LE) }
  PutLE32(@Buf[Pos], LongWord(Info.WindowSize)); Inc(Pos, 4);

  { Number of addresses (1 byte) }
  Buf[Pos] := Byte(Length(Info.Addresses));
  Inc(Pos);

  { Addresses: Zone(2) + Net(2) + Node(2) + Point(2) each }
  for I := 0 to High(Info.Addresses) do
  begin
    PutLE16(@Buf[Pos], Info.Addresses[I].Zone); Inc(Pos, 2);
    PutLE16(@Buf[Pos], Info.Addresses[I].Net); Inc(Pos, 2);
    PutLE16(@Buf[Pos], Info.Addresses[I].Node); Inc(Pos, 2);
    PutLE16(@Buf[Pos], Info.Addresses[I].Point); Inc(Pos, 2);
  end;

  { NUL-terminated strings }
  Inc(Pos, PutNulStr(@Buf[Pos], Info.Password));
  Inc(Pos, PutNulStr(@Buf[Pos], Info.SysName));
  Inc(Pos, PutNulStr(@Buf[Pos], Info.SysOp));
  Inc(Pos, PutNulStr(@Buf[Pos], Info.Mailer));

  SetLength(Result, Pos);
  Move(Buf[0], Result[0], Pos);
end;


function CometParseInit(Payload: PByte; PayLen: LongWord;
  out Info: TCometInitInfo): Boolean;
var
  P, Limit: PByte;
  NumAddrs, I: Integer;
begin
  Result := False;
  FillChar(Info, SizeOf(Info), 0);
  SetLength(Info.Addresses, 0);

  { Minimum: 4+4+4+4+1 = 17 bytes (no addresses, empty strings) }
  if PayLen < 17 then Exit;

  P := Payload;
  Limit := Payload + PayLen;

  Info.Version := GetLE32(P); Inc(P, 4);
  Info.Caps := GetLE32(P); Inc(P, 4);
  Info.MaxBlock := GetLE32(P); Inc(P, 4);
  Info.WindowSize := Word(GetLE32(P)); Inc(P, 4);

  { Addresses }
  NumAddrs := P^; Inc(P);
  if P + (NumAddrs * 8) > Limit then Exit;

  SetLength(Info.Addresses, NumAddrs);
  for I := 0 to NumAddrs - 1 do
  begin
    Info.Addresses[I].Zone := GetLE16(P); Inc(P, 2);
    Info.Addresses[I].Net := GetLE16(P); Inc(P, 2);
    Info.Addresses[I].Node := GetLE16(P); Inc(P, 2);
    Info.Addresses[I].Point := GetLE16(P); Inc(P, 2);
    Info.Addresses[I].Domain := '';
  end;

  { NUL-terminated strings }
  Info.Password := GetNulStr(P, Limit);
  Info.SysName := GetNulStr(P, Limit);
  Info.SysOp := GetNulStr(P, Limit);
  Info.Mailer := GetNulStr(P, Limit);

  Result := True;
end;


function CometBuildInitAck(const Sess: TCometSession): TBytes;
begin
  Result := nil;
  SetLength(Result, 12);
  PutLE32(@Result[0], Sess.SharedCaps);
  PutLE32(@Result[4], Sess.MaxBlock);
  PutLE32(@Result[8], LongWord(Sess.WindowSize));
end;


function CometParseInitAck(Payload: PByte; PayLen: LongWord;
  out SharedCaps: LongWord; out MaxBlock: LongWord;
  out WindowSize: Word): Boolean;
begin
  Result := False;
  if PayLen < 12 then Exit;

  SharedCaps := GetLE32(Payload);
  MaxBlock := GetLE32(Payload + 4);
  WindowSize := Word(GetLE32(Payload + 8));
  Result := True;
end;


{ ---- Negotiation ---- }

procedure CometNegotiate(const OurInit, RemoteInit: TCometInitInfo;
  const Password: string; out Sess: TCometSession);
var
  I: Integer;
begin
  FillChar(Sess, SizeOf(Sess), 0);

  { Capabilities: intersection of both sides }
  Sess.SharedCaps := OurInit.Caps and RemoteInit.Caps;

  { Window: minimum of both }
  if OurInit.WindowSize < RemoteInit.WindowSize then
    Sess.WindowSize := OurInit.WindowSize
  else
    Sess.WindowSize := RemoteInit.WindowSize;

  if Sess.WindowSize < 1 then Sess.WindowSize := 1;
  if Sess.WindowSize > COMET_MAXWINDOW then Sess.WindowSize := COMET_MAXWINDOW;

  { Block size: minimum of both }
  if OurInit.MaxBlock < RemoteInit.MaxBlock then
    Sess.MaxBlock := OurInit.MaxBlock
  else
    Sess.MaxBlock := RemoteInit.MaxBlock;

  if Sess.MaxBlock < COMET_MINBLKLEN then Sess.MaxBlock := COMET_MINBLKLEN;
  if Sess.MaxBlock > COMET_MAXBLKLEN then Sess.MaxBlock := COMET_MAXBLKLEN;

  { Remote info }
  SetLength(Sess.RemoteAddrs, Length(RemoteInit.Addresses));
  for I := 0 to High(RemoteInit.Addresses) do
    Sess.RemoteAddrs[I] := RemoteInit.Addresses[I];
  Sess.RemoteSysName := RemoteInit.SysName;
  Sess.RemoteSysOp := RemoteInit.SysOp;
  Sess.RemoteMailer := RemoteInit.Mailer;

  { Password check (case-insensitive) }
  if Password = '' then
    Sess.PasswordOk := True  { No password required }
  else
    Sess.PasswordOk := CompareText(Password, RemoteInit.Password) = 0;
end;


{ ---- Session Management ---- }

procedure CometSessionInit(var State: TCometSessionState;
  Sock: TCometSocket; IsOriginator: Boolean;
  const RemoteIP: string; RemotePort: Word);
begin
  FillChar(State, SizeOf(State), 0);
  State.Sock := Sock;
  State.IsOriginator := IsOriginator;
  State.RemoteIP := RemoteIP;
  State.RemotePort := RemotePort;
  State.Active := False;
  CometFrameRxInit(State.FrameRx);
end;

procedure CometSessionDone(var State: TCometSessionState);
begin
  CometFrameRxDone(State.FrameRx);
  State.Active := False;
end;

procedure CometBuildOurInit(var State: TCometSessionState;
  const Cfg: TCometConfig);
var
  I: Integer;
begin
  State.OurInit.Version := COMET_REVISION;
  State.OurInit.Caps := Cfg.Capabilities;
  State.OurInit.MaxBlock := Cfg.MaxBlockSize;
  State.OurInit.WindowSize := Cfg.WindowSize;
  State.OurInit.SysName := Cfg.SysName;
  State.OurInit.SysOp := Cfg.SysOp;
  State.OurInit.Mailer := COMET_NAME + '/' + COMET_VERSION;

  SetLength(State.OurInit.Addresses, Length(Cfg.Addresses));
  for I := 0 to High(Cfg.Addresses) do
    State.OurInit.Addresses[I] := Cfg.Addresses[I];

  { Password: look up by remote address if we know it already }
  State.OurInit.Password := '';
end;


{ ---- Full Handshake ---- }

function CometHandshake(var State: TCometSessionState;
  const Cfg: TCometConfig): TCometHandshakeResult;
var
  PeekBuf: string;
  InitPayload: TBytes;
  Frame: TCometFrame;
  Ret: Integer;
  Deadline: TDateTime;
  Password: string;
  AckPayload: TBytes;
  SharedCaps: LongWord;
  MaxBlock: LongWord;
  WindowSize: Word;
begin
  Result := chrProtocolError;

  { Build our INIT info }
  CometBuildOurInit(State, Cfg);

  if State.IsOriginator then
  begin
    { --- Originator flow --- }

    { Step 1: Send banner }
    if not CometSendBanner(State.Sock) then
    begin
      Result := chrDisconnect;
      Exit;
    end;

    { Step 2: Receive banner }
    Result := CometRecvBanner(State.Sock, Cfg.TimeoutHandshake, PeekBuf);
    if Result <> chrOK then Exit;
  end;
  { Answerer: banner already validated by daemon accept loop }

  { Step 3: Send our INIT }

  { If remote addresses known, look up password }
  if Length(State.Session.RemoteAddrs) > 0 then
    State.OurInit.Password := CometCfgGetPassword(Cfg, State.Session.RemoteAddrs[0])
  else
    State.OurInit.Password := '';

  InitPayload := CometBuildInit(State.OurInit);
  if not CometFrameSend(State.Sock, NPKT_INIT, 0,
    @InitPayload[0], Length(InitPayload)) then
  begin
    Result := chrDisconnect;
    Exit;
  end;

  LogInfo('Sent INIT: %s (%s) [%s]',
    [State.OurInit.SysName, State.OurInit.SysOp, State.OurInit.Mailer]);

  { Step 4: Wait for remote INIT }
  Deadline := Now + (Cfg.TimeoutHandshake / 86400.0);

  while Now < Deadline do
  begin
    if not CometTcpWaitData(State.Sock, 500) then
    begin
      if not CometTcpConnected(State.Sock) then
      begin
        Result := chrDisconnect;
        Exit;
      end;
      Continue;
    end;

    Ret := CometFrameRecv(State.Sock, State.FrameRx, Frame);

    case Ret of
      N_NOPKT: Continue;
      N_CARRIER:
        begin
          Result := chrDisconnect;
          Exit;
        end;
      N_BADPKT:
        begin
          LogWarning('Bad frame during handshake');
          Continue;
        end;
    end;

    if Ret = NPKT_INIT then
    begin
      { Parse remote INIT }
      if not CometParseInit(Frame.Payload, Frame.PayLen, State.RemoteInit) then
      begin
        LogError('Cannot parse remote INIT');
        Result := chrProtocolError;
        Exit;
      end;

      LogInfo('Rcvd INIT: %s (%s) [%s]',
        [State.RemoteInit.SysName, State.RemoteInit.SysOp,
         State.RemoteInit.Mailer]);

      if Length(State.RemoteInit.Addresses) > 0 then
      begin
        LogInfo('Remote address: %s',
          [CometAddrToStr(State.RemoteInit.Addresses[0])]);

        { Now that we know who they are, set the password for negotiation }
        Password := CometCfgGetPassword(Cfg, State.RemoteInit.Addresses[0]);
      end
      else
        Password := '';

      { Negotiate parameters }
      CometNegotiate(State.OurInit, State.RemoteInit, Password,
        State.Session);
      State.Session.WeAreOriginator := State.IsOriginator;

      { Check password }
      if not State.Session.PasswordOk then
      begin
        LogError('Password mismatch for %s',
          [CometAddrToStr(State.RemoteInit.Addresses[0])]);
        { Send HALT to inform remote }
        CometFrameSend(State.Sock, NPKT_HALT, 0, nil, 0);
        Result := chrBadPassword;
        Exit;
      end;

      { Step 5: Send INITACK }
      AckPayload := CometBuildInitAck(State.Session);
      if not CometFrameSend(State.Sock, NPKT_INITACK, 0,
        @AckPayload[0], Length(AckPayload)) then
      begin
        Result := chrDisconnect;
        Exit;
      end;

      LogInfo('Session negotiated: caps=$%08X blk=%d win=%d',
        [State.Session.SharedCaps, State.Session.MaxBlock,
         State.Session.WindowSize]);

      { Step 6: Wait for remote INITACK }
      Break;  { Fall through to INITACK wait loop }
    end;
  end;

  { Wait for INITACK }
  while Now < Deadline do
  begin
    if not CometTcpWaitData(State.Sock, 500) then
    begin
      if not CometTcpConnected(State.Sock) then
      begin
        Result := chrDisconnect;
        Exit;
      end;
      Continue;
    end;

    Ret := CometFrameRecv(State.Sock, State.FrameRx, Frame);

    case Ret of
      N_NOPKT: Continue;
      N_CARRIER:
        begin
          Result := chrDisconnect;
          Exit;
        end;
      N_BADPKT: Continue;
      Ord(NPKT_HALT):
        begin
          LogError('Remote sent HALT during handshake');
          Result := chrProtocolError;
          Exit;
        end;
    end;

    if Ret = NPKT_INITACK then
    begin
      if CometParseInitAck(Frame.Payload, Frame.PayLen,
        SharedCaps, MaxBlock, WindowSize) then
      begin
        LogInfo('Rcvd INITACK: caps=$%08X blk=%d win=%d',
          [SharedCaps, MaxBlock, WindowSize]);

        { Verify agreement (should match our negotiation) }
        State.Active := True;
        Result := chrOK;
        Exit;
      end
      else
      begin
        LogError('Cannot parse INITACK');
        Result := chrProtocolError;
        Exit;
      end;
    end;
  end;

  { If we get here, we timed out }
  if Result <> chrOK then
    Result := chrTimeout;
end;


end.