fpc-comet/examples/example_inbound.pas

{ example_inbound -- accept inbound Comet connections on a TCP
  port and receive files into secure or unsecure directories
  based on authentication state.

  Demonstrates:
    - IComTransport backed by an accepted TCP socket
    - TComFsProvider configured with a default unsecure dir,
      then overridden per session via OnPostAuth
    - Bidir transfer (any files queued on Provider get sent
      during the same batch)

  Build:
    fpc -Mobjfpc -Sh -Fu../src -Fu../../fpc-msgbase/src \
        -Fu../../fpc-log/src example_inbound.pas

  Run:
    ./example_inbound port password secure-dir unsecure-dir [temp-dir]

  Example:
    ./example_inbound 24554 SecretPwd \
      /var/spool/inbound/secure \
      /var/spool/inbound/unsecure \
      /tmp/cm

  A peer authenticating with CRAM-MD5 / plain / ED25519 lands
  files in secure-dir.  A peer presenting NOPWD ('-') lands in
  unsecure-dir.  An auth-failed peer never gets here -- the
  session aborts before cmpAuth completes.

  Serial accept loop -- one session at a time.  Real daemons
  spawn a thread per session.  UNIX only (Linux / FreeBSD). }

program example_inbound;

{$mode objfpc}{$H+}

uses
  SysUtils,
  Sockets, BaseUnix,
  log.types, log.console,
  mb.address,
  cm.types, cm.config, cm.transport, cm.provider, cm.driver,
  cm.xfer, cm.transport.tcp, cm.provider.fs;

type
  TSessionPolicy = class
  public
    Password:    string;
    SecureDir:   string;
    UnsecureDir: string;
    function  Lookup(const Addr: TFTNAddress): string;
    procedure PostAuth(Direction: TCometDirection;
                       Authenticated: Boolean;
                       AuthMethod: TCometAuthMethod;
                       const RemoteAddrs: TFTNAddressArray;
                       var InboundDir: string;
                       var Reject: Boolean;
                       var RejectReason: string);
  end;

function TSessionPolicy.Lookup(const Addr: TFTNAddress): string;
begin
  Result := Password;
end;

procedure TSessionPolicy.PostAuth(Direction: TCometDirection;
  Authenticated: Boolean; AuthMethod: TCometAuthMethod;
  const RemoteAddrs: TFTNAddressArray;
  var InboundDir: string; var Reject: Boolean;
  var RejectReason: string);
var
  AddrStr: string;
begin
  if Length(RemoteAddrs) > 0 then
    AddrStr := FTNAddressToString(RemoteAddrs[0])
  else
    AddrStr := '(no addr)';

  if Authenticated and
     (AuthMethod in [cmAuthCRAM, cmAuthPlain, cmAuthED25519]) then
  begin
    InboundDir := SecureDir;
    WriteLn(Format('  routing [%s] -> secure   (auth=%d dir=%s)',
      [AddrStr, Ord(AuthMethod), InboundDir]));
  end
  else
  begin
    InboundDir := UnsecureDir;
    WriteLn(Format('  routing [%s] -> unsecure (auth=%d dir=%s)',
      [AddrStr, Ord(AuthMethod), InboundDir]));
  end;
end;

procedure Usage;
begin
  WriteLn('usage: example_inbound port password secure-dir unsecure-dir [temp-dir]');
  Halt(2);
end;

procedure RunOneSession(ClientSock: TSocket;
  const Pwd, SecureDir, UnsecureDir, TempDir: string;
  Logger: TConsoleLogger);
var
  Cfg: TCometSessionConfig;
  Transport: TComTcpTransport;
  Provider:  TComFsProvider;
  Session:   TComSession;
  Xfer:      TCometXfer;
  Policy:    TSessionPolicy;
  R:         TCometSessionResult;
begin
  Policy := TSessionPolicy.Create;
  Policy.Password    := Pwd;
  Policy.SecureDir   := SecureDir;
  Policy.UnsecureDir := UnsecureDir;

  Provider  := TComFsProvider.Create(UnsecureDir, TempDir);
  Transport := TComTcpTransport.CreateFromFd(ClientSock, '');

  CMConfigDefaults(Cfg);
  SetLength(Cfg.LocalAddrs, 1);
  Cfg.LocalAddrs[0] := MakeFTNAddress(1, 218, 700, 0);
  Cfg.SystemName := 'fpc-comet example-inbound';
  Cfg.MailerName := 'example_inbound/0.1';
  Cfg.Transport  := Transport;
  Cfg.Provider   := Provider;
  Cfg.Log              := @Logger.Log;
  Cfg.OnLookupPassword := @Policy.Lookup;
  Cfg.OnPostAuth       := @Policy.PostAuth;

  Session := TComSession.Create(cmDirInbound, Cfg);
  Xfer    := TCometXfer.Create(Session);
  try
    Session.SetTransferHooks(@Xfer.HandleFrame, @Xfer.Step,
                              @Xfer.IsDone);
    Xfer.Start;
    while Session.NextStep do
      Transport.WaitReady(True, False, 50);
    R := Session.Result_;
    WriteLn(Format(
      'session end: success=%s auth=%d files_in=%d files_out=%d',
      [BoolToStr(R.Success, True), Ord(R.AuthMethod),
       Xfer.FilesReceived, Xfer.FilesSent]));
  finally
    Xfer.Free;
    Session.Free;
    Policy.Free;
  end;
end;

var
  Port: Word;
  Pwd, SecureDir, UnsecureDir, TempDir: string;
  ListenSock, ClientSock: TSocket;
  BindAddr: TInetSockAddr;
  ClientAddr: TInetSockAddr;
  AddrLen: TSockLen;
  OptVal: LongInt;
  Logger: TConsoleLogger;
begin
  if ParamCount < 4 then Usage;
  Port         := StrToIntDef(ParamStr(1), 24554);
  Pwd          := ParamStr(2);
  SecureDir    := ParamStr(3);
  UnsecureDir  := ParamStr(4);
  if ParamCount >= 5 then TempDir := ParamStr(5)
                     else TempDir := '/tmp/fpccomet';

  ForceDirectories(SecureDir);
  ForceDirectories(UnsecureDir);
  ForceDirectories(TempDir);

  Logger := TConsoleLogger.Create(llDebug);

  ListenSock := fpSocket(AF_INET, SOCK_STREAM, 0);
  if ListenSock < 0 then begin WriteLn('socket() failed'); Halt(3); end;

  OptVal := 1;
  fpSetSockOpt(ListenSock, SOL_SOCKET, SO_REUSEADDR,
    @OptVal, SizeOf(OptVal));

  FillChar(BindAddr, SizeOf(BindAddr), 0);
  BindAddr.sin_family      := AF_INET;
  BindAddr.sin_port        := htons(Port);
  BindAddr.sin_addr.s_addr := 0;

  if fpBind(ListenSock, @BindAddr, SizeOf(BindAddr)) <> 0 then
  begin WriteLn('bind() failed'); Halt(4); end;
  if fpListen(ListenSock, 5) <> 0 then
  begin WriteLn('listen() failed'); Halt(5); end;

  WriteLn(Format('listening on 0.0.0.0:%d', [Port]));
  WriteLn(Format('  secure   -> %s', [SecureDir]));
  WriteLn(Format('  unsecure -> %s', [UnsecureDir]));
  WriteLn(Format('  temp     -> %s', [TempDir]));

  while True do
  begin
    AddrLen := SizeOf(ClientAddr);
    ClientSock := fpAccept(ListenSock, @ClientAddr, @AddrLen);
    if ClientSock < 0 then Continue;
    WriteLn('accepted connection');
    try
      RunOneSession(ClientSock, Pwd, SecureDir, UnsecureDir,
                    TempDir, Logger);
    except
      on E: Exception do
        WriteLn('session error: ', E.Message);
    end;
  end;
end.