{ 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.