comet/src/cometcrypt.pas

{
  Comet - Direct TCP File Transfer for FidoNet
  cometcrypt.pas - Session encryption: X25519 key exchange + ChaCha20

  Provides full session encryption for the Comet native protocol using
  keys already configured for ED25519 authentication. No certificates,
  no external libraries, no CA infrastructure required.

  Key exchange:
    Both sides generate ephemeral X25519 keypairs and exchange public
    keys. The shared secret is computed via Diffie-Hellman. Ephemeral
    keys provide forward secrecy -- compromising long-term keys does
    not reveal past session content.

  Encryption:
    ChaCha20 stream cipher (RFC 8439) with per-direction keys and
    counters. Each frame body (TYPE+SEQ+PAYLOAD+CRC32) is encrypted
    after CRC computation and decrypted before CRC verification.

  Key derivation:
    session_key = SHA-256(shared_secret || ephemeral_pub_A || ephemeral_pub_B)
    send_key    = SHA-256(session_key || "comet-send-" || direction_byte)
    recv_key    = SHA-256(session_key || "comet-recv-" || direction_byte)

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

{$mode objfpc}{$H+}
{$R-}{$Q-}  { Range and overflow checks OFF - crypto arithmetic }

interface

uses
  SysUtils, cometed25519, cometsha;

type
  { X25519 key types }
  TX25519Key = array[0..31] of Byte;

  { ChaCha20 cipher state }
  TChacha20State = record
    Key:     array[0..31] of Byte;  { 256-bit key                          }
    Nonce:   array[0..11] of Byte;  { 96-bit nonce (zeroed, counter-based) }
    Counter: QWord;                 { Block counter                        }
    Block:   array[0..63] of Byte;  { Current keystream block              }
    Used:    Integer;               { Bytes used in current block          }
  end;

  { Session encryption context }
  TCometCrypt = record
    Active:  Boolean;               { Encryption is active                 }
    TxState: TChacha20State;        { Transmit cipher state                }
    RxState: TChacha20State;        { Receive cipher state                 }
  end;


{ ---- X25519 Key Exchange ---- }

{ Generate a random X25519 keypair.
  PrivKey is the clamped 32-byte scalar.
  PubKey is the 32-byte Montgomery u-coordinate. }
procedure X25519Keypair(out PrivKey, PubKey: TX25519Key);

{ Scalar multiplication on Curve25519 (Montgomery form).
  R = K * U. Exported for testing. }
procedure X25519ScalarMult(const K, U: TX25519Key; out R: TX25519Key);

{ Compute shared secret = X25519(our_private, their_public).
  Returns False if the result is all-zero (bad public key). }
function X25519SharedSecret(const OurPriv, TheirPub: TX25519Key;
  out Secret: TX25519Key): Boolean;


{ ---- ChaCha20 Stream Cipher ---- }

{ Initialize a ChaCha20 cipher state with a 32-byte key. }
procedure ChaCha20Init(var State: TChacha20State;
  const Key: array of Byte);

{ Encrypt/decrypt data in place using ChaCha20 (XOR with keystream). }
procedure ChaCha20Crypt(var State: TChacha20State;
  Data: PByte; Len: LongWord);


{ ---- Session Encryption ---- }

{ Derive send/recv keys from shared secret and ephemeral public keys,
  and initialize the encryption context. IsOriginator determines
  key direction (originator's send key = answerer's recv key). }
procedure CometCryptInit(var Crypt: TCometCrypt;
  const SharedSecret, EphPubLocal, EphPubRemote: TX25519Key;
  IsOriginator: Boolean);

{ Encrypt a frame body in place (TYPE+SEQ+PAYLOAD+CRC32).
  Call after CRC computation, before sending. }
procedure CometCryptEncrypt(var Crypt: TCometCrypt;
  Data: PByte; Len: LongWord);

{ Decrypt a frame body in place (TYPE+SEQ+PAYLOAD+CRC32).
  Call after receiving, before CRC verification. }
procedure CometCryptDecrypt(var Crypt: TCometCrypt;
  Data: PByte; Len: LongWord);


implementation

uses
  cometlog;


{ ---- X25519 Montgomery Ladder ---- }

{ Clamp a 32-byte scalar for X25519 per RFC 7748. }
procedure X25519Clamp(var K: TX25519Key);
begin
  K[0]  := K[0] and 248;
  K[31] := (K[31] and 127) or 64;
end;

{ Montgomery ladder scalar multiplication on Curve25519.
  Computes Result = k * u where u is a Montgomery u-coordinate.
  Uses field element operations from cometed25519. }
procedure X25519ScalarMult(const K, U: TX25519Key; out R: TX25519Key);
{ Montgomery ladder per RFC 7748 Section 5.
  Clamps scalar and decodes u-coordinate per spec.
  All temporaries are distinct to avoid aliasing bugs. }
var
  Scalar: TX25519Key;
  UCopy: TX25519Key;
  U_fe, X2, Z2, X3, Z3: TFieldElement;
  tA, tAA, tB, tBB, tE: TFieldElement;
  tC, tD, tDA, tCB: TFieldElement;
  tDAp, tDAm, tT: TFieldElement;
  Swap, KT: LongInt;
  I: Integer;
begin
  { decodeScalar25519: clamp scalar per RFC 7748 }
  Move(K, Scalar, 32);
  X25519Clamp(Scalar);

  { decodeUCoordinate: clear high bit per RFC 7748 }
  Move(U, UCopy, 32);
  UCopy[31] := UCopy[31] and $7F;

  FE_FromBytes(U_fe, @UCopy[0]);
  FE_1(X2);
  FE_0(Z2);
  FE_Copy(X3, U_fe);
  FE_1(Z3);

  Swap := 0;

  for I := 254 downto 0 do
  begin
    KT := (Scalar[I shr 3] shr (I and 7)) and 1;
    Swap := Swap xor KT;
    FE_CSwap(X2, X3, Swap);
    FE_CSwap(Z2, Z3, Swap);
    Swap := KT;

    FE_Add(tA, X2, Z2);
    FE_Sq(tAA, tA);
    FE_Sub(tB, X2, Z2);
    FE_Sq(tBB, tB);
    FE_Sub(tE, tAA, tBB);
    FE_Add(tC, X3, Z3);
    FE_Sub(tD, X3, Z3);
    FE_Mul(tDA, tD, tA);
    FE_Mul(tCB, tC, tB);

    FE_Add(tDAp, tDA, tCB);
    FE_Sq(X3, tDAp);

    FE_Sub(tDAm, tDA, tCB);
    FE_Sq(tDAm, tDAm);
    FE_Mul(Z3, U_fe, tDAm);

    FE_Mul(X2, tAA, tBB);

    FE_Mul121666(tT, tE);       { 121666 * E                 }
    FE_Sub(tT, tT, tE);         { 121665 * E  (a24 for Curve25519) }
    FE_Add(tT, tAA, tT);        { AA + a24 * E               }
    FE_Mul(Z2, tE, tT);         { z_2 = E * (AA + a24 * E)   }
  end;

  FE_CSwap(X2, X3, Swap);
  FE_CSwap(Z2, Z3, Swap);

  FE_Invert(Z2, Z2);
  FE_Mul(X2, X2, Z2);
  FE_ToBytes(TED25519PublicKey(R), X2);
end;


{ The X25519 base point (u=9). }
const
  X25519_BASEPOINT: TX25519Key = (
    9, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
  );

procedure X25519Keypair(out PrivKey, PubKey: TX25519Key);
var
  Seed: TED25519Seed;
begin
  { Generate 32 random bytes }
  ED25519RandomSeed(Seed);
  Move(Seed, PrivKey, 32);
  X25519Clamp(PrivKey);

  { Public key = PrivKey * basepoint }
  X25519ScalarMult(PrivKey, X25519_BASEPOINT, PubKey);
end;


function X25519SharedSecret(const OurPriv, TheirPub: TX25519Key;
  out Secret: TX25519Key): Boolean;
var
  I: Integer;
  Check: Byte;
begin
  X25519ScalarMult(OurPriv, TheirPub, Secret);

  { Check for all-zero result (invalid public key) }
  Check := 0;
  for I := 0 to 31 do
    Check := Check or Secret[I];
  Result := Check <> 0;
end;


{ ---- ChaCha20 Stream Cipher (RFC 8439) ---- }

type
  TChaCha20Block = array[0..15] of LongWord;

function RotL32(X: LongWord; N: Integer): LongWord; inline;
begin
  Result := (X shl N) or (X shr (32 - N));
end;

procedure QuarterRound(var A, B, C, D: LongWord); inline;
begin
  A := A + B; D := D xor A; D := RotL32(D, 16);
  C := C + D; B := B xor C; B := RotL32(B, 12);
  A := A + B; D := D xor A; D := RotL32(D, 8);
  C := C + D; B := B xor C; B := RotL32(B, 7);
end;

procedure ChaCha20Block(const Key: array of Byte;
  Counter: LongWord; const Nonce: array of Byte;
  out Output: array of Byte);
var
  State, Working: TChaCha20Block;
  I: Integer;
begin
  { Initialize state }
  State[0]  := $61707865;  { "expa" }
  State[1]  := $3320646e;  { "nd 3" }
  State[2]  := $79622d32;  { "2-by" }
  State[3]  := $6b206574;  { "te k" }

  { Key (little-endian LongWords) }
  for I := 0 to 7 do
    State[4 + I] := LongWord(Key[I*4]) or (LongWord(Key[I*4+1]) shl 8) or
                    (LongWord(Key[I*4+2]) shl 16) or (LongWord(Key[I*4+3]) shl 24);

  { Counter }
  State[12] := Counter;

  { Nonce (little-endian LongWords) }
  for I := 0 to 2 do
    State[13 + I] := LongWord(Nonce[I*4]) or (LongWord(Nonce[I*4+1]) shl 8) or
                     (LongWord(Nonce[I*4+2]) shl 16) or (LongWord(Nonce[I*4+3]) shl 24);

  { Copy state to working }
  Working := State;

  { 20 rounds (10 double-rounds) }
  for I := 1 to 10 do
  begin
    { Column rounds }
    QuarterRound(Working[0], Working[4], Working[8],  Working[12]);
    QuarterRound(Working[1], Working[5], Working[9],  Working[13]);
    QuarterRound(Working[2], Working[6], Working[10], Working[14]);
    QuarterRound(Working[3], Working[7], Working[11], Working[15]);
    { Diagonal rounds }
    QuarterRound(Working[0], Working[5], Working[10], Working[15]);
    QuarterRound(Working[1], Working[6], Working[11], Working[12]);
    QuarterRound(Working[2], Working[7], Working[8],  Working[13]);
    QuarterRound(Working[3], Working[4], Working[9],  Working[14]);
  end;

  { Add original state }
  for I := 0 to 15 do
    Working[I] := Working[I] + State[I];

  { Serialize to bytes (little-endian) }
  for I := 0 to 15 do
  begin
    Output[I*4]     := Byte(Working[I]);
    Output[I*4 + 1] := Byte(Working[I] shr 8);
    Output[I*4 + 2] := Byte(Working[I] shr 16);
    Output[I*4 + 3] := Byte(Working[I] shr 24);
  end;
end;


procedure ChaCha20Init(var State: TChacha20State;
  const Key: array of Byte);
begin
  FillChar(State, SizeOf(State), 0);
  Move(Key[0], State.Key[0], 32);
  State.Counter := 0;
  State.Used := 64;  { Force new block generation on first use }
end;


procedure ChaCha20Crypt(var State: TChacha20State;
  Data: PByte; Len: LongWord);
var
  I: LongWord;
  Avail: Integer;
begin
  I := 0;
  while I < Len do
  begin
    { Generate new keystream block if needed }
    if State.Used >= 64 then
    begin
      ChaCha20Block(State.Key, LongWord(State.Counter),
        State.Nonce, State.Block);
      Inc(State.Counter);
      State.Used := 0;
    end;

    { XOR data with keystream }
    Avail := 64 - State.Used;
    if Avail > Integer(Len - I) then
      Avail := Integer(Len - I);

    while Avail > 0 do
    begin
      Data[I] := Data[I] xor State.Block[State.Used];
      Inc(I);
      Inc(State.Used);
      Dec(Avail);
    end;
  end;
end;


{ ---- Session Encryption Setup ---- }

procedure CometCryptInit(var Crypt: TCometCrypt;
  const SharedSecret, EphPubLocal, EphPubRemote: TX25519Key;
  IsOriginator: Boolean);
var
  Ctx: TSHA256Context;
  SessionKey: TSHA256Digest;
  SendKey, RecvKey: TSHA256Digest;
  DirByte: Byte;
  Buf: array[0..31] of Byte;
begin
  FillChar(Crypt, SizeOf(Crypt), 0);

  { Derive session key = SHA-256(secret || pubA || pubB)
    Always hash originator's key first for consistency. }
  SHA256Init(Ctx);
  Move(SharedSecret, Buf, 32);
  SHA256Update(Ctx, Buf, 32);
  if IsOriginator then
  begin
    Move(EphPubLocal, Buf, 32);
    SHA256Update(Ctx, Buf, 32);
    Move(EphPubRemote, Buf, 32);
    SHA256Update(Ctx, Buf, 32);
  end
  else
  begin
    Move(EphPubRemote, Buf, 32);
    SHA256Update(Ctx, Buf, 32);
    Move(EphPubLocal, Buf, 32);
    SHA256Update(Ctx, Buf, 32);
  end;
  SHA256Final(Ctx, SessionKey);

  { Derive directional keys:
    Key-A = SHA-256(session_key || "comet-keystream-A")
    Key-B = SHA-256(session_key || "comet-keystream-B")
    Originator sends with Key-A, receives with Key-B.
    Answerer sends with Key-B, receives with Key-A. }
  DirByte := Ord('A');
  SHA256Init(Ctx);
  SHA256Update(Ctx, SessionKey, 32);
  SHA256Update(Ctx, DirByte, 1);
  SHA256Final(Ctx, SendKey);

  DirByte := Ord('B');
  SHA256Init(Ctx);
  SHA256Update(Ctx, SessionKey, 32);
  SHA256Update(Ctx, DirByte, 1);
  SHA256Final(Ctx, RecvKey);

  if IsOriginator then
  begin
    ChaCha20Init(Crypt.TxState, SendKey);
    ChaCha20Init(Crypt.RxState, RecvKey);
  end
  else
  begin
    ChaCha20Init(Crypt.TxState, RecvKey);
    ChaCha20Init(Crypt.RxState, SendKey);
  end;

  { Wipe intermediate keys }
  FillChar(SessionKey, SizeOf(SessionKey), 0);
  FillChar(SendKey, SizeOf(SendKey), 0);
  FillChar(RecvKey, SizeOf(RecvKey), 0);

  Crypt.Active := True;
  LogInfo('Session encryption active (X25519 + ChaCha20)');
end;


procedure CometCryptEncrypt(var Crypt: TCometCrypt;
  Data: PByte; Len: LongWord);
begin
  if Crypt.Active then
    ChaCha20Crypt(Crypt.TxState, Data, Len);
end;


procedure CometCryptDecrypt(var Crypt: TCometCrypt;
  Data: PByte; Len: LongWord);
begin
  if Crypt.Active then
    ChaCha20Crypt(Crypt.RxState, Data, Len);
end;


end.