tmcpserver.prgModel Context Protocol (MCP) is an open protocol that enables seamless integration between LLM applications and external data sources and tools. Whether you’re building an AI-powered IDE, enhancing a chat interface, or creating custom AI workflows, MCP provides a standardized way to connect LLMs with the context they need.
Code: Select all | Expand
/**
* MCP.prg - Model Context Protocol Implementation in Harbour
* Based on the Python MCP SDK
*/
#include "FiveWin.ch"
/**
* Main MCP server class
*/
CREATE CLASS TMCPServer
VAR cName // Server name
VAR aResources // Resource collection
VAR aTools // Tools collection
VAR aPrompts // Template collection
VAR oContext // Application context
METHOD New(cName)
METHOD AddResource(cPattern, bCallback)
METHOD AddTool(cName, cDescription, bCallback)
METHOD AddPrompt(cName, cDescription, bCallback)
METHOD CallTool(hParams)
METHOD GetPrompt(hParams)
METHOD Run()
METHOD Initialize()
METHOD HandleMessage(cMessage)
METHOD ListPrompts()
METHOD ListResources()
METHOD ListTools()
METHOD ReadResource(hParams)
METHOD RespondJSON(hResponse)
ENDCLASS
METHOD New(cName) CLASS TMCPServer
::cName := cName
::aResources := {}
::aTools := {}
::aPrompts := {}
::oContext := TMCPContext():New()
RETURN Self
/**
* Registers a resource with a URI pattern
*/
METHOD AddResource(cPattern, bCallback) CLASS TMCPServer
LOCAL oResource
oResource := TMCPResource():New(cPattern, bCallback)
AAdd(::aResources, oResource)
RETURN oResource
/**
* Registers a tool that can be invoked by the LLM
*/
METHOD AddTool(cName, cDescription, bCallback) CLASS TMCPServer
LOCAL oTool
oTool := TMCPTool():New(cName, cDescription, bCallback)
AAdd(::aTools, oTool)
RETURN oTool
/**
* Registers a prompt for interaction with the LLM
*/
METHOD AddPrompt(cName, cDescription, bCallback) CLASS TMCPServer
LOCAL oPrompt
oPrompt := TMCPPrompt():New(cName, cDescription, bCallback)
AAdd(::aPrompts, oPrompt)
RETURN oPrompt
/**
* Executes a tool with the specified parameters
*
* @param hParams Call parameters including the tool name
* @return Result of the tool execution
*/
METHOD CallTool(hParams) CLASS TMCPServer
LOCAL cToolName, i, oTool, xResult, hError := {=>}
// Get the name of the tool to execute
cToolName := hParams["name"]
// Find the tool in the collection
oTool := NIL
FOR i := 1 TO Len(::aTools)
IF ::aTools[i]:cName == cToolName
oTool := ::aTools[i]
EXIT
ENDIF
NEXT
// Check if the tool exists
IF oTool == NIL
// Tool not found
hError["code"] := -32602
hError["message"] := "Tool not found: " + cToolName
RETURN hError
ENDIF
// Execute the tool with the provided parameters
BEGIN SEQUENCE WITH {|oErr| hError := ErrorHandler(oErr) }
xResult := oTool:Execute(hParams["params"])
RECOVER
// Error during execution was handled by ErrorHandler
RETURN hError
END SEQUENCE
RETURN xResult
/**
* Gets a template based on the provided name
*
* @param hParams Parameters including the template name
* @return Template content or error message
*/
METHOD GetPrompt(hParams) CLASS TMCPServer
LOCAL cPromptName, i, oPrompt, xResult, hError := {=>}
// Get the name of the requested template
cPromptName := hParams["name"]
// Find the template in the collection
oPrompt := NIL
FOR i := 1 TO Len(::aPrompts)
IF ::aPrompts[i]:cName == cPromptName
oPrompt := ::aPrompts[i]
EXIT
ENDIF
NEXT
// Verify if the template was found
IF oPrompt == NIL
// Template not found
hError["code"] := -32602
hError["message"] := "Template not found: " + cPromptName
RETURN hError
ENDIF
// Execute the template callback with the parameters
BEGIN SEQUENCE WITH {|oErr| hError := ErrorHandler(oErr) }
xResult := oPrompt:Execute(hParams["params"])
RECOVER
// Error during template processing was handled by ErrorHandler
RETURN hError
END SEQUENCE
RETURN xResult
/**
* Initializes the server and sends capabilities
*/
METHOD Initialize() CLASS TMCPServer
LOCAL hCapabilities, hResponse
// Define server capabilities
hCapabilities := {=>}
hCapabilities["prompts"] := {=>}
hCapabilities["prompts"]["listChanged"] := .T.
hCapabilities["resources"] := {=>}
hCapabilities["resources"]["subscribe"] := .T.
hCapabilities["resources"]["listChanged"] := .T.
hCapabilities["tools"] := {=>}
hCapabilities["tools"]["listChanged"] := .T.
// Create initialization response
hResponse := {=>}
hResponse["jsonrpc"] := "2.0"
hResponse["id"] := "init"
hResponse["result"] := {=>}
hResponse["result"]["name"] := ::cName
hResponse["result"]["version"] := "1.0.0"
hResponse["result"]["capabilities"] := hCapabilities
RETURN ::RespondJSON(hResponse)
/**
* Handles an incoming MCP protocol message
*/
METHOD HandleMessage(cMessage) CLASS TMCPServer
LOCAL hMessage, cMethod, xResult, hResponse
hMessage := hb_jsonDecode(cMessage)
cMethod := hMessage["method"]
// Process based on the requested method
DO CASE
CASE cMethod == "initialize"
RETURN ::Initialize()
CASE cMethod == "list_tools"
xResult := ::ListTools()
CASE cMethod == "list_resources"
xResult := ::ListResources()
CASE cMethod == "list_prompts"
xResult := ::ListPrompts()
CASE cMethod == "call_tool"
xResult := ::CallTool(hMessage["params"])
CASE cMethod == "read_resource"
xResult := ::ReadResource(hMessage["params"])
CASE cMethod == "get_prompt"
xResult := ::GetPrompt(hMessage["params"])
OTHERWISE
// Unknown method
hResponse := {=>}
hResponse["jsonrpc"] := "2.0"
hResponse["id"] := hMessage["id"]
hResponse["error"] := {=>}
hResponse["error"]["code"] := -32601
hResponse["error"]["message"] := "Method not supported: " + cMethod
RETURN ::RespondJSON(hResponse)
ENDCASE
// Build successful response
hResponse := {=>}
hResponse["jsonrpc"] := "2.0"
hResponse["id"] := hMessage["id"]
hResponse["result"] := xResult
RETURN ::RespondJSON(hResponse)
/**
* Returns the list of available templates
*/
METHOD ListPrompts() CLASS TMCPServer
LOCAL aPrompts := {}, i, hPrompt
// Convert each template to the format expected by the protocol
FOR i := 1 TO Len(::aPrompts)
hPrompt := {=>}
hPrompt["name"] := ::aPrompts[i]:cName
hPrompt["description"] := ::aPrompts[i]:cDescription
AAdd(aPrompts, hPrompt)
NEXT
RETURN aPrompts
/**
* Returns the list of available resources
*/
METHOD ListResources() CLASS TMCPServer
LOCAL aResources := {}, i, hResource
// Convert each resource to the format expected by the protocol
FOR i := 1 TO Len(::aResources)
hResource := {=>}
hResource["pattern"] := ::aResources[i]:cPattern
AAdd(aResources, hResource)
NEXT
RETURN aResources
/**
* Returns the list of available tools
*/
METHOD ListTools() CLASS TMCPServer
LOCAL aTools := {}, i, hTool
// Convert each tool to the format expected by the protocol
FOR i := 1 TO Len(::aTools)
hTool := {=>}
hTool["name"] := ::aTools[i]:cName
hTool["description"] := ::aTools[i]:cDescription
AAdd(aTools, hTool)
NEXT
RETURN aTools
/**
* Reads a resource according to the provided URI
*
* @param hParams Parameters including the resource URI to read
* @return Resource content or error message
*/
METHOD ReadResource(hParams) CLASS TMCPServer
LOCAL cUri, i, oResource, xResult, hError := {=>}
// Get the URI of the resource to read
cUri := hParams["uri"]
// Find a resource that matches the URI
oResource := NIL
FOR i := 1 TO Len(::aResources)
IF ::aResources[i]:Match(cUri)
oResource := ::aResources[i]
EXIT
ENDIF
NEXT
// Verify if a matching resource was found
IF oResource == NIL
// Resource not found
hError["code"] := -32602
hError["message"] := "Resource not found for URI: " + cUri
RETURN hError
ENDIF
// Execute the resource callback with the URI
BEGIN SEQUENCE WITH {|oErr| hError := ErrorHandler(oErr) }
xResult := oResource:Execute(cUri)
RECOVER
// Error during resource reading was handled by ErrorHandler
RETURN hError
END SEQUENCE
RETURN xResult
/**
* Sends a JSON response
*/
METHOD RespondJSON(hResponse) CLASS TMCPServer
LOCAL cResponse := hb_jsonEncode(hResponse)
? "Content-Length: " + AllTrim(Str(Len(cResponse)))
? ""
? cResponse
RETURN NIL
/**
* Runs the server in main mode
*/
METHOD Run() CLASS TMCPServer
LOCAL cLine, nContentLength, cMessage
// Main read/write loop via stdio
DO WHILE .T.
nContentLength := 0
// Read headers
DO WHILE .T.
cLine := FReadLine( 0 )
IF Empty(cLine)
EXIT
ENDIF
IF "Content-Length:" $ cLine
nContentLength := Val(SubStr(cLine, At(":", cLine) + 1))
ENDIF
IF cLine == ""
EXIT
ENDIF
ENDDO
// Read message body
IF nContentLength > 0
cMessage := Space(nContentLength)
FRead(0, @cMessage, nContentLength)
// Process message
::HandleMessage(cMessage)
ENDIF
ENDDO
RETURN NIL
/**
* Class to represent an MCP resource
*/
CREATE CLASS TMCPResource
VAR cPattern // URI pattern
VAR bCallback // Callback function
METHOD New(cPattern, bCallback)
METHOD Match(cUri)
METHOD Execute(cUri)
ENDCLASS
METHOD New(cPattern, bCallback) CLASS TMCPResource
::cPattern := cPattern
::bCallback := bCallback
RETURN Self
METHOD Match(cUri) CLASS TMCPResource
LOCAL aPatternParts, aUriParts, i, cPatternPart, cUriPart
LOCAL lMatch := .T.
LOCAL cPatternCopy, cUriCopy
// Normalize slashes and spaces
cPatternCopy := StrTran(::cPattern, "\", "/")
cUriCopy := StrTran(cUri, "\", "/")
// If patterns are exactly the same, they match
IF cPatternCopy == cUriCopy
RETURN .T.
ENDIF
// Split the pattern and URI into parts separated by "/"
aPatternParts := hb_ATokens(cPatternCopy, "/")
aUriParts := hb_ATokens(cUriCopy, "/")
// If they have different number of parts, they don't match
// (unless the pattern ends with "/**" for wildcard matching)
IF Len(aPatternParts) != Len(aUriParts) .AND. ;
!(Len(aPatternParts) > 0 .AND. aPatternParts[Len(aPatternParts)] == "**")
RETURN .F.
ENDIF
// Go through all parts and check for matches
FOR i := 1 TO Min(Len(aPatternParts), Len(aUriParts))
cPatternPart := aPatternParts[i]
cUriPart := aUriParts[i]
// Case 1: Exact match
IF cPatternPart == cUriPart
LOOP
ENDIF
// Case 2: Parameter with format {param}
IF Left(cPatternPart, 1) == "{" .AND. Right(cPatternPart, 1) == "}"
// It's a parameter, always matches
LOOP
ENDIF
// Case 3: Simple wildcard "*"
IF cPatternPart == "*"
// Simple wildcard, matches any part
LOOP
ENDIF
// Case 4: Recursive wildcard "**"
IF cPatternPart == "**"
// Recursive wildcard, matches the rest of the URI
RETURN .T.
ENDIF
// If we get here, there's no match
lMatch := .F.
// EXIT
NEXT
RETURN lMatch
METHOD Execute(cUri) CLASS TMCPResource
LOCAL aPatternParts, aUriParts, i, cPatternPart, cUriPart
LOCAL hParams := {=>} // Hash to store extracted parameters
LOCAL cPatternCopy, cUriCopy, cParamName
LOCAL xResult, hInfo := {=>}, hError := {=>}
// Normalize slashes
cPatternCopy := StrTran(::cPattern, "\", "/")
cUriCopy := StrTran(cUri, "\", "/")
// Split the pattern and URI into parts separated by "/"
aPatternParts := hb_ATokens(cPatternCopy, "/")
aUriParts := hb_ATokens(cUriCopy, "/")
// Extract parameters according to matching parts
FOR i := 1 TO Min(Len(aPatternParts), Len(aUriParts))
cPatternPart := aPatternParts[i]
cUriPart := aUriParts[i]
// If it's a parameter with format {param}
IF Left(cPatternPart, 1) == "{" .AND. Right(cPatternPart, 1) == "}"
// Extract parameter name without the braces
cParamName := SubStr(cPatternPart, 2, Len(cPatternPart) - 2)
// Store parameter value in the hash
hParams[cParamName] := cUriPart
ENDIF
NEXT
// Prepare information object for the callback
hInfo["uri"] := cUri
hInfo["pattern"] := ::cPattern
hInfo["params"] := hParams
// Handle possible errors during callback execution
BEGIN SEQUENCE WITH {|oErr| hError := ErrorHandler(oErr) }
// Execute the callback with the collected information
xResult := Eval(::bCallback, hInfo)
RECOVER
// Error was handled by ErrorHandler
RETURN hError
END SEQUENCE
RETURN xResult
/**
* Class to represent an MCP tool
*/
CREATE CLASS TMCPTool
VAR cName // Name
VAR cDescription // Description
VAR bCallback // Callback function
METHOD New(cName, cDescription, bCallback)
METHOD Execute(hParams)
ENDCLASS
METHOD New(cName, cDescription, bCallback) CLASS TMCPTool
::cName := cName
::cDescription := cDescription
::bCallback := bCallback
RETURN Self
METHOD Execute(hParams) CLASS TMCPTool
// Execute the callback with the provided parameters
RETURN Eval(::bCallback, hParams)
/**
* Class to represent an MCP prompt
*/
CREATE CLASS TMCPPrompt
VAR cName // Name
VAR cDescription // Description
VAR bCallback // Callback function
METHOD New(cName, cDescription, bCallback)
METHOD Execute(hParams)
ENDCLASS
METHOD New(cName, cDescription, bCallback) CLASS TMCPPrompt
::cName := cName
::cDescription := cDescription
::bCallback := bCallback
RETURN Self
METHOD Execute(hParams) CLASS TMCPPrompt
// Execute the callback with the provided parameters
RETURN Eval(::bCallback, hParams)
/**
* Class to handle execution context
*/
CREATE CLASS TMCPContext
VAR hLifespanContext // Lifespan context
METHOD New()
METHOD SetLifespanContext(hContext)
METHOD GetLifespanContext()
ENDCLASS
METHOD New() CLASS TMCPContext
::hLifespanContext := {=>}
RETURN Self
METHOD SetLifespanContext(hContext) CLASS TMCPContext
::hLifespanContext := hContext
RETURN NIL
METHOD GetLifespanContext() CLASS TMCPContext
RETURN ::hLifespanContext
/**
* Error handler function for MCP operations
*/
FUNCTION ErrorHandler(oError)
LOCAL hError := {=>}
hError["code"] := -32603
hError["message"] := "Error during execution: " + ;
IIf(ValType(oError) == "C", oError, ;
IIf(ValType(oError) == "O" .AND. HB_ISOBJECT(oError) .AND. ;
__objHasMsg(oError, "Operation"), ;
oError:Operation(), "Unknown error"))
RETURN hError
function CreateMCPServer( cName)
LOCAL oServer := TMCPServer():New(cName)
// Initialize the server
oServer:Initialize()
RETURN oServer
/**
* FReadLine() - Reads a line from a file or standard input
*
* @param nHandle File handle (0 for stdin, 1 for stdout, 2 for stderr)
* @param nMaxLen Maximum length to read (default is 4096)
* @param cEOL End of line character(s) (default is CRLF or LF)
* @return cLine Line read from the file/stdin
*/
FUNCTION FReadLine(nHandle, nMaxLen, cEOL)
LOCAL cChar, cLine := "", nByte
LOCAL lCR := .F.
// Default values
nHandle := IIf(nHandle == NIL, 0, nHandle)
nMaxLen := IIf(nMaxLen == NIL, 4096, nMaxLen)
cEOL := IIf(cEOL == NIL, hb_OSNewLine(), cEOL)
// Read one byte at a time until EOL or max length
DO WHILE Len(cLine) < nMaxLen
// Allocate space for a single character
cChar := Space(1)
// Read a single byte
nByte := FRead(nHandle, @cChar, 1)
// EOF or error
IF nByte <= 0
IF Empty(cLine)
RETURN NIL // Return NIL on EOF with no data read
ELSE
EXIT // Return whatever was read if EOF after some data
ENDIF
ENDIF
// Handle different EOL sequences
IF cChar == Chr(13) // CR (Carriage Return)
lCR := .T.
// Don't add CR to result string, wait to see if LF follows
ELSEIF cChar == Chr(10) // LF (Line Feed)
IF lCR
// If we just saw a CR, this is a CRLF sequence
EXIT // End of line found (CRLF)
ELSE
// Just a LF without CR
EXIT // End of line found (LF only)
ENDIF
ELSE
// Add any pending CR if not followed by LF
IF lCR
cLine += Chr(13)
lCR := .F.
ENDIF
// Add the character to the result
cLine += cChar
ENDIF
ENDDO
RETURN cLine