FireDACMCPServer.dpr

program FireDACMCPServer;

{$APPTYPE CONSOLE}

(*
  ==============================================================================
  FireDAC MCP Server  -  a database bridge for AI assistants
  ==============================================================================

  This showcase turns ANY database FireDAC can reach into an MCP server.
  You give it a single FireDAC connection string plus an access mode, and it
  exposes the database to an MCP client (Claude Desktop, Claude Code, MCP
  Inspector, ...) over stdio. The server owns the connection and mediates every
  call, enforcing the access mode and a SQL-safety classifier on the way.

  Because it is driven entirely by the connection string and by FireDAC's
  engine-agnostic metadata API, the same binary works with SQLite, PostgreSQL,
  MySQL / MariaDB, SQL Server, Oracle, Firebird / InterBase and ODBC sources.

  ------------------------------------------------------------------------------
  USAGE
  ------------------------------------------------------------------------------
    FireDACMCPServer [options]

  Options:
    -conn="<FireDAC connection string>"   The database to connect to. Required
                                          unless -conn-env is used.
    -conn-env=<ENV_VAR>                   Read the connection string from this
                                          environment variable instead (keeps
                                          passwords off the command line).
    -mode=<readonly|readwrite|full>       Access level (default: readonly).
    -maxrows=<n>                          Hard cap on rows returned (default 1000).
    -timeout=<ms>                         Per-command timeout in milliseconds.
    -allow-multi                          Permit ';'-separated multiple statements
                                          in one call (off by default).
    -help                                 Show this help and exit.

  Access modes:
    readonly   Only SELECT and metadata tools are exposed. No mutation tool is
               registered at all, so the AI cannot change anything.
    readwrite  Adds run_statement for INSERT / UPDATE / DELETE / MERGE (DML).
    full       Also allows DDL (CREATE / ALTER / DROP / TRUNCATE) and the
               otherwise-blocked statements (PRAGMA, ATTACH, ...).

  ------------------------------------------------------------------------------
  EXAMPLES
  ------------------------------------------------------------------------------
    # SQLite, read only (safe default)
    FireDACMCPServer -conn="DriverID=SQLite;Database=C:\data\app.db"

    # PostgreSQL, read/write, password from an environment variable
    set PG_CONN=DriverID=PG;Server=localhost;Database=sales;User_Name=app;Password=secret
    FireDACMCPServer -conn-env=PG_CONN -mode=readwrite

    # SQL Server, full admin access
    FireDACMCPServer -mode=full ^
      -conn="DriverID=MSSQL;Server=localhost;Database=Northwind;OSAuthent=Yes"

  ------------------------------------------------------------------------------
  REGISTERING WITH AN MCP CLIENT (stdio)
  ------------------------------------------------------------------------------
    {
      "mcpServers": {
        "database": {
          "command": "C:\\path\\to\\FireDACMCPServer.exe",
          "args": ["-conn=DriverID=SQLite;Database=C:\\data\\app.db",
                   "-mode=readonly"]
        }
      }
    }
*)

uses
  System.SysUtils,
  System.Classes,
  // --- FireDAC core --------------------------------------------------------
  FireDAC.Stan.Intf,
  FireDAC.Stan.Def,
  FireDAC.Stan.Async,
  FireDAC.Stan.Option,
  FireDAC.Stan.Error,
  FireDAC.Stan.Param,
  FireDAC.Stan.Pool,
  FireDAC.Stan.ExprFuncs,
  FireDAC.Phys,
  FireDAC.Phys.Intf,
  FireDAC.DApt,
  FireDAC.ConsoleUI.Wait,   // headless wait handler (no VCL/FMX forms)
  // --- FireDAC physical drivers (link every engine you want to support) ----
  FireDAC.Phys.SQLite,   FireDAC.Phys.SQLiteDef,
  FireDAC.Phys.PG,       FireDAC.Phys.PGDef,
  FireDAC.Phys.MySQL,    FireDAC.Phys.MySQLDef,
  FireDAC.Phys.MSSQL,    FireDAC.Phys.MSSQLDef,
  FireDAC.Phys.ODBC,     FireDAC.Phys.ODBCDef,
  FireDAC.Phys.IB,       FireDAC.Phys.IBDef,
  FireDAC.Phys.FB,       FireDAC.Phys.FBDef,
  FireDAC.Phys.Oracle,   FireDAC.Phys.OracleDef,
  // --- MCP SDK -------------------------------------------------------------
  TMS.MCP.Server,
  TMS.MCP.Tools,
  TMS.MCP.Helpers,
  TMS.MCP.Transport.STDIO,
  // --- this demo -----------------------------------------------------------
  DBConnectionManager in 'DBConnectionManager.pas';

procedure ShowHelp;
begin
  WriteLn(ErrOutput, 'FireDAC MCP Server');
  WriteLn(ErrOutput, '==================');
  WriteLn(ErrOutput, 'Expose any FireDAC-reachable database to an MCP client over stdio.');
  WriteLn(ErrOutput, '');
  WriteLn(ErrOutput, 'Usage: FireDACMCPServer [options]');
  WriteLn(ErrOutput, '');
  WriteLn(ErrOutput, '  -conn="<connection string>"   FireDAC connection string (required');
  WriteLn(ErrOutput, '                                unless -conn-env is used).');
  WriteLn(ErrOutput, '  -conn-env=<ENV_VAR>           Read the connection string from an');
  WriteLn(ErrOutput, '                                environment variable instead.');
  WriteLn(ErrOutput, '  -mode=<readonly|readwrite|full>  Access level (default: readonly).');
  WriteLn(ErrOutput, '  -maxrows=<n>                  Max rows returned (default 1000).');
  WriteLn(ErrOutput, '  -timeout=<ms>                 Per-command timeout in milliseconds.');
  WriteLn(ErrOutput, '  -allow-multi                  Allow multiple ;-separated statements.');
  WriteLn(ErrOutput, '  -help                         Show this help.');
end;

// Split "-name=value" into its parts. Returns False for flags without '='.
function ParseNameValue(const AParam: string; out AName, AValue: string): Boolean;
var
  EqPos: Integer;
begin
  Result := False;
  if not AParam.StartsWith('-') then
    Exit;
  EqPos := AParam.IndexOf('=');
  if EqPos < 0 then
    Exit;
  AName  := AParam.Substring(1, EqPos - 1).ToLower;
  AValue := AParam.Substring(EqPos + 1);
  // Strip surrounding quotes the shell may have preserved.
  if (AValue.Length >= 2) and AValue.StartsWith('"') and AValue.EndsWith('"') then
    AValue := AValue.Substring(1, AValue.Length - 2);
  Result := True;
end;

function ParseCommandLine: TServerConfig;
var
  I: Integer;
  Param, Name, Value, EnvVar: string;
begin
  // Defaults: the safest possible posture.
  Result.ConnectionString    := '';
  Result.AccessMode          := amReadOnly;
  Result.MaxRows             := 0; // manager applies its default
  Result.TimeoutMs           := 0;
  Result.AllowMultiStatement := False;
  Result.ServerName          := 'FireDACMCPServer';
  Result.ServerVersion       := '1.0.0';
  EnvVar := '';

  for I := 1 to ParamCount do
  begin
    Param := ParamStr(I);

    if (Param = '-help') or (Param = '--help') or (Param = '/?') then
    begin
      ShowHelp;
      Halt(0);
    end
    else if (Param = '-allow-multi') or (Param = '--allow-multi') then
      Result.AllowMultiStatement := True
    else if ParseNameValue(Param, Name, Value) then
    begin
      if Name = 'conn' then
        Result.ConnectionString := Value
      else if Name = 'conn-env' then
        EnvVar := Value
      else if Name = 'mode' then
      begin
        if not TDBConnectionManager.StrToAccessMode(Value, Result.AccessMode) then
        begin
          WriteLn(ErrOutput, 'Unknown mode: ' + Value +
            ' (expected readonly | readwrite | full)');
          Halt(1);
        end;
      end
      else if Name = 'maxrows' then
        Result.MaxRows := StrToIntDef(Value, Result.MaxRows)
      else if Name = 'timeout' then
        Result.TimeoutMs := StrToIntDef(Value, Result.TimeoutMs);
    end;
  end;

  // -conn-env wins only if -conn was not given directly.
  if (Result.ConnectionString = '') and (EnvVar <> '') then
    Result.ConnectionString := GetEnvironmentVariable(EnvVar);

  // Note: an empty connection string is allowed. The server then starts in
  // "deferred" mode and exposes a `connect` tool so the client can supply the
  // connection details at runtime (see DBConnectionManager.RegisterTools).
end;

var
  Config : TServerConfig;
  Manager: TDBConnectionManager;
  Server : TTMSMCPServer;
begin
  try
    // JSON numbers must always use '.' as the decimal separator.
    FormatSettings.DecimalSeparator := '.';

    Config  := ParseCommandLine;
    Manager := TDBConnectionManager.Create(Config);
    try
      // 1. If a connection string was supplied, connect now (fail fast with a
      //    clear message). Otherwise start in deferred mode: the server comes
      //    up unconnected and exposes a `connect` tool instead.
      if Config.ConnectionString.Trim <> '' then
      begin
        try
          Manager.Connect;
        except
          on E: Exception do
          begin
            WriteLn(ErrOutput, 'Failed to connect to the database: ' + E.Message);
            Halt(2);
          end;
        end;
        WriteLn(ErrOutput, Format(
          '[FireDACMCPServer] connected  mode=%s  maxRows=%d',
          [TDBConnectionManager.AccessModeToStr(Config.AccessMode), Config.MaxRows]));
      end
      else
        WriteLn(ErrOutput,
          '[FireDACMCPServer] no connection string - waiting for the connect tool.');

      // 2. Create the MCP server and register tools (data tools if already
      //    connected, otherwise just the connect tool).
      Server := TTMSMCPServer.Create(nil);
      try
        Server.ServerName    := Config.ServerName;
        Server.ServerVersion := Config.ServerVersion;
        Manager.RegisterTools(Server);

        // 3. Start stdio transport (created automatically) and run the loop.
        Server.Start;
        Server.Run;
      finally
        Server.Free;
      end;
    finally
      Manager.Free;
    end;

  except
    on E: Exception do
    begin
      // stderr only: stdout is reserved for the JSON-RPC stream.
      WriteLn(ErrOutput, 'Fatal: ' + E.Message);
      ExitCode := 1;
    end;
  end;
end.