fpc-binkp/examples/example_inbound.pas

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

  Demonstrates:
  - IBPTransport backed by an accepted TCP socket.
  - TBPFsProvider configured with a default inbound dir (unsecure),
    then overridden per session via OnPostAuth.
  - OnPostAuth hook inspecting Direction + AuthMethod to pick
    secure vs unsecure routing.

  Build:  fpc -Mobjfpc -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/bp

  A remote that authenticates via CRAM-MD5 lands files in
  secure-dir.  A remote that presented NOPWD ("-") lands in
  unsecure-dir.  A remote that failed authentication never gets
  here — the session aborts before bppAuthComplete.

  Serial accept loop — one session at a time.  Real daemons
  would 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,
  bp.types, bp.config, bp.session,
  bp.transport.tcp, bp.provider.fs;

type
  { Per-session policy object — owns the password the session
    authenticates against and the secure/unsecure directories
    the OnPostAuth hook routes between. }
  TSessionPolicy = class
  public
    Password:    string;
    SecureDir:   string;
    UnsecureDir: string;
    PeerPubHex:  string;     { from FPC_BINKP_PEERKEY env -- empty ok }
    function Lookup(const Addr: TFTNAddress): string;
    function LookupPub(const Addr: TFTNAddress): string;
    procedure PostAuth(Direction: TBPDirection;
                       Authenticated: Boolean;
                       AuthMethod: TBPAuthMethod;
                       const RemoteAddrs: TFTNAddressArray;
                       var InboundDir: string;
                       var Reject: Boolean;
                       var RejectReason: string);
  end;

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

function TSessionPolicy.LookupPub(const Addr: TFTNAddress): string;
begin
  Result := PeerPubHex;
end;

procedure TSessionPolicy.PostAuth(Direction: TBPDirection;
  Authenticated: Boolean; AuthMethod: TBPAuthMethod;
  const RemoteAddrs: TFTNAddressArray;
  var InboundDir: string; var Reject: Boolean;
  var RejectReason: string);
var
  AddrStr: string;
begin
  { Route to secure only when:
    - this is an inbound session (we accepted, peer dialed us)
    - the peer authenticated AND used a real credential
      (CRAM-MD5 or plain password, not NOPWD).
    Outbound sessions we initiated are treated as secure
    implicitly -- we picked the peer.  For this inbound example,
    unauthenticated peers (NOPWD) land in unsecure. }
  if Length(RemoteAddrs) > 0 then
    AddrStr := FTNAddressToString(RemoteAddrs[0])
  else
    AddrStr := '(no addr)';

  if Authenticated and (AuthMethod in [bpAuthCRAM, bpAuthPlain, bpAuthED25519]) 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: TBPSessionConfig;
  Transport: TBPTcpTransport;
  Provider:  TBPFsProvider;
  Session:   TBPSession;
  Policy:    TSessionPolicy;
begin
  Policy := TSessionPolicy.Create;
  Policy.Password    := Pwd;
  Policy.SecureDir   := SecureDir;
  Policy.UnsecureDir := UnsecureDir;
  Policy.PeerPubHex  := GetEnvironmentVariable('FPC_BINKP_PEERKEY');

  { Provider initialised with the unsecure dir as its default;
    OnPostAuth overrides per session via the OverrideDir path. }
  Provider := TBPFsProvider.Create(UnsecureDir, TempDir);
  Transport := TBPTcpTransport.CreateFromFd(ClientSock, '');

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

  Session := TBPSession.Create(bpDirInbound, Cfg);
  try
    while Session.NextStep do
      Transport.WaitReady(True, False, 50);
    WriteLn(Format('session end: success=%s files_in=%d files_out=%d',
      [BoolToStr(Session.Result_.Success, True),
       Session.Result_.FilesReceived, Session.Result_.FilesSent]));
  finally
    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/fpcbinkp';
  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;    { INADDR_ANY }

  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.