diff --git a/src/Core/MCPServer.Logger.pas b/src/Core/MCPServer.Logger.pas index 5ac356a..d5c9d32 100644 --- a/src/Core/MCPServer.Logger.pas +++ b/src/Core/MCPServer.Logger.pas @@ -269,36 +269,58 @@ class function TLogger.GetOnLogMessage: TLogMessageProc; end; class procedure TLogger.SetLogToConsole(const Value: Boolean); +var + lInstance: TLogger; begin - Instance.FLogToConsole := Value; + lInstance := Instance; + if Assigned(lInstance) then + lInstance.FLogToConsole := Value; end; class procedure TLogger.SetLogToFile(const Value: Boolean); +var + lInstance: TLogger; begin - Instance.FLogToFile := Value; + lInstance := Instance; + if Assigned(lInstance) then + lInstance.FLogToFile := Value; end; class procedure TLogger.SetLogFileName(const Value: string); +var + lInstance: TLogger; begin FLock.Enter; try - Instance.FLogFileName := Value; + lInstance := Instance; + if lInstance = nil then + Exit; + + lInstance.FLogFileName := Value; - if Assigned(Instance.FLogFile) then - FreeAndNil(Instance.FLogFile); + if Assigned(lInstance.FLogFile) then + FreeAndNil(lInstance.FLogFile); finally FLock.Leave; end; end; class procedure TLogger.SetMinLogLevel(const Value: TLogLevel); +var + lInstance: TLogger; begin - Instance.FMinLogLevel := Value; + lInstance := Instance; + if Assigned(lInstance) then + lInstance.FMinLogLevel := Value; end; class procedure TLogger.SetOnLogMessage(const Value: TLogMessageProc); +var + lInstance: TLogger; begin - Instance.FOnLogMessage := Value; + lInstance := Instance; + if Assigned(lInstance) then + lInstance.FOnLogMessage := Value; end; class function TLogger.GetUseStdErr: Boolean; @@ -307,8 +329,12 @@ class function TLogger.GetUseStdErr: Boolean; end; class procedure TLogger.SetUseStdErr(const Value: Boolean); +var + lInstance: TLogger; begin - Instance.FUseStdErr := Value; + lInstance := Instance; + if Assigned(lInstance) then + lInstance.FUseStdErr := Value; end; end. \ No newline at end of file diff --git a/src/Core/MCPServer.ManagerRegistry.pas b/src/Core/MCPServer.ManagerRegistry.pas index 6353db0..e1f90c3 100644 --- a/src/Core/MCPServer.ManagerRegistry.pas +++ b/src/Core/MCPServer.ManagerRegistry.pas @@ -43,9 +43,11 @@ procedure TMCPManagerRegistry.RegisterManager(const Manager: IMCPCapabilityManag end; function TMCPManagerRegistry.GetManagerForMethod(const Method: string): IMCPCapabilityManager; +var + Manager: IMCPCapabilityManager; begin Result := nil; - for var Manager in FManagers do + for Manager in FManagers do begin if Manager.HandlesMethod(Method) then begin diff --git a/src/Core/MCPServer.Settings.pas b/src/Core/MCPServer.Settings.pas index ae4b8f0..acb9cbe 100644 --- a/src/Core/MCPServer.Settings.pas +++ b/src/Core/MCPServer.Settings.pas @@ -27,7 +27,7 @@ TMCPSettings = class procedure LoadDefaults; procedure CreateDefaultSettingsFile; public - constructor Create(const ASettingsFile: string = ''); + constructor Create(const ASettingsFile: string = ''; const ACreateFile: Boolean = True); destructor Destroy; override; procedure LoadFromFile; @@ -55,7 +55,7 @@ implementation { TMCPSettings } -constructor TMCPSettings.Create(const ASettingsFile: string); +constructor TMCPSettings.Create(const ASettingsFile: string; const ACreateFile: Boolean); begin inherited Create; @@ -66,7 +66,7 @@ constructor TMCPSettings.Create(const ASettingsFile: string); LoadDefaults; - if not TFile.Exists(FSettingsFile) then + if ACreateFile and (not TFile.Exists(FSettingsFile)) then begin TLogger.Info('Settings file not found. Creating default settings: ' + FSettingsFile); CreateDefaultSettingsFile; @@ -104,8 +104,10 @@ function TMCPSettings.GetProtocol: string; end; procedure TMCPSettings.CreateDefaultSettingsFile; +var + IniFile: TIniFile; begin - var IniFile := TIniFile.Create(FSettingsFile); + IniFile := TIniFile.Create(FSettingsFile); try IniFile.WriteString('Server', '; Server configuration', ''); IniFile.WriteInteger('Server', 'Port', FPort); @@ -130,11 +132,13 @@ procedure TMCPSettings.CreateDefaultSettingsFile; end; procedure TMCPSettings.LoadFromFile; +var + IniFile: TIniFile; begin if not TFile.Exists(FSettingsFile) then Exit; - var IniFile := TIniFile.Create(FSettingsFile); + IniFile := TIniFile.Create(FSettingsFile); try FPort := IniFile.ReadInteger('Server', 'Port', FPort); FHost := IniFile.ReadString('Server', 'Host', FHost); @@ -167,8 +171,10 @@ procedure TMCPSettings.LoadFromFile; end; procedure TMCPSettings.SaveToFile; +var + IniFile: TIniFile; begin - var IniFile := TIniFile.Create(FSettingsFile); + IniFile := TIniFile.Create(FSettingsFile); try IniFile.WriteInteger('Server', 'Port', FPort); IniFile.WriteString('Server', 'Host', FHost); diff --git a/src/Managers/MCPServer.CoreManager.pas b/src/Managers/MCPServer.CoreManager.pas index f3af9f1..f73f761 100644 --- a/src/Managers/MCPServer.CoreManager.pas +++ b/src/Managers/MCPServer.CoreManager.pas @@ -68,17 +68,26 @@ function TMCPCoreManager.ExecuteMethod(const Method: string; const Params: TJSON end; function TMCPCoreManager.Initialize(const Params: TJSONObject): TValue; +var + Capabilities: TJSONObject; + ClientInfo: TJSONObject; + ClientName: TJSONValue; + ClientVersion: TJSONValue; + ResourcesCap: TJSONObject; + ResultJSON: TJSONObject; + ServerInfo: TJSONObject; + ToolsCap: TJSONObject; begin TLogger.Info('MCP Initialize called'); if Assigned(Params) then begin - var ClientInfo := Params.GetValue('clientInfo') as TJSONObject; + ClientInfo := Params.GetValue('clientInfo') as TJSONObject; if Assigned(ClientInfo) then begin - var ClientName := ClientInfo.GetValue('name'); - var ClientVersion := ClientInfo.GetValue('version'); + ClientName := ClientInfo.GetValue('name'); + ClientVersion := ClientInfo.GetValue('version'); if Assigned(ClientName) and Assigned(ClientVersion) then TLogger.Info(Format('Client: %s v%s', [ClientName.Value, ClientVersion.Value])); @@ -87,26 +96,36 @@ function TMCPCoreManager.Initialize(const Params: TJSONObject): TValue; FSessionID := TGuid.NewGuid.ToString; - var ResultJSON := TJSONObject.Create; + ResultJSON := TJSONObject.Create; try ResultJSON.AddPair('protocolVersion', MCP_PROTOCOL_VERSION); - var Capabilities := TJSONObject.Create; + Capabilities := TJSONObject.Create; ResultJSON.AddPair('capabilities', Capabilities); - var ToolsCap := TJSONObject.Create; + ToolsCap := TJSONObject.Create; Capabilities.AddPair('tools', ToolsCap); +{$IF COMPILERVERSION <= 29} + ToolsCap.AddPair('supportsProgress', TJSONFalse.Create); + ToolsCap.AddPair('supportsCancellation', TJSONFalse.Create); +{$ELSE} ToolsCap.AddPair('supportsProgress', TJSONBool.Create(False)); ToolsCap.AddPair('supportsCancellation', TJSONBool.Create(False)); +{$ENDIF} - var ResourcesCap := TJSONObject.Create; + ResourcesCap := TJSONObject.Create; Capabilities.AddPair('resources', ResourcesCap); +{$IF COMPILERVERSION <= 29} + ResourcesCap.AddPair('subscribe', TJSONFalse.Create); + ResourcesCap.AddPair('listChanged', TJSONFalse.Create); +{$ELSE} ResourcesCap.AddPair('subscribe', TJSONBool.Create(False)); ResourcesCap.AddPair('listChanged', TJSONBool.Create(False)); +{$ENDIF} ResultJSON.AddPair('sessionId', FSessionID); - var ServerInfo := TJSONObject.Create; + ServerInfo := TJSONObject.Create; ResultJSON.AddPair('serverInfo', ServerInfo); ServerInfo.AddPair('name', FSettings.ServerName); ServerInfo.AddPair('version', FSettings.ServerVersion); @@ -121,10 +140,12 @@ function TMCPCoreManager.Initialize(const Params: TJSONObject): TValue; end; function TMCPCoreManager.Ping: TValue; +var + ResultJSON: TJSONObject; begin TLogger.Info('MCP Ping called'); - var ResultJSON := TJSONObject.Create; + ResultJSON := TJSONObject.Create; try Result := TValue.From(ResultJSON); except diff --git a/src/Managers/MCPServer.ResourcesManager.pas b/src/Managers/MCPServer.ResourcesManager.pas index ec0d4bc..1c1f529 100644 --- a/src/Managers/MCPServer.ResourcesManager.pas +++ b/src/Managers/MCPServer.ResourcesManager.pas @@ -81,25 +81,32 @@ procedure TMCPResourcesManager.RegisterResource(const Resource: IMCPResource); end; procedure TMCPResourcesManager.RegisterBuiltInResources; +var + ResourceURI: string; begin - for var ResourceURI in TMCPRegistry.GetResourceURIs do + for ResourceURI in TMCPRegistry.GetResourceURIs do begin RegisterResource(TMCPRegistry.CreateResource(ResourceURI)); end; end; function TMCPResourcesManager.ListResources: TValue; +var + Resource: IMCPResource; + ResourcesArray: TJSONArray; + ResourceObj: TJSONObject; + ResultJSON: TJSONObject; begin TLogger.Info('MCP ListResources called'); - - var ResultJSON := TJSONObject.Create; + + ResultJSON := TJSONObject.Create; try - var ResourcesArray := TJSONArray.Create; + ResourcesArray := TJSONArray.Create; ResultJSON.AddPair('resources', ResourcesArray); - for var Resource in FResources.Values do + for Resource in FResources.Values do begin - var ResourceObj := TJSONObject.Create; + ResourceObj := TJSONObject.Create; ResourceObj.AddPair('uri', Resource.URI); ResourceObj.AddPair('name', Resource.Name); ResourceObj.AddPair('description', Resource.Description); @@ -115,32 +122,38 @@ function TMCPResourcesManager.ListResources: TValue; end; function TMCPResourcesManager.ReadResource(const Params: System.JSON.TJSONObject): TValue; +var + ContentItem: TJSONObject; + ContentsArray: TJSONArray; + Resource: IMCPResource; + ResourceText: string; + ResultJSON: TJSONObject; + URI: string; + URIValue: TJSONValue; begin - var URIValue := Params.GetValue('uri'); - var URI: string; + URIValue := Params.GetValue('uri'); if Assigned(URIValue) then URI := URIValue.Value else URI := ''; - + TLogger.Info('MCP ReadResource called for URI: ' + URI); - - var ResultJSON := TJSONObject.Create; + + ResultJSON := TJSONObject.Create; try - var ContentsArray := TJSONArray.Create; + ContentsArray := TJSONArray.Create; ResultJSON.AddPair('contents', ContentsArray); - - var ContentItem := TJSONObject.Create; + + ContentItem := TJSONObject.Create; ContentsArray.AddElement(ContentItem); - - var Resource: IMCPResource; + if FResources.TryGetValue(URI, Resource) then begin ContentItem.AddPair('uri', Resource.URI); ContentItem.AddPair('mimeType', Resource.MimeType); try - var ResourceText := Resource.Read; + ResourceText := Resource.Read; ContentItem.AddPair('text', ResourceText); except on E: Exception do @@ -164,12 +177,15 @@ function TMCPResourcesManager.ReadResource(const Params: System.JSON.TJSONObject end; function TMCPResourcesManager.ListResourceTemplates: TValue; +var + ResourceTemplatesArray: TJSONArray; + ResultJSON: TJSONObject; begin TLogger.Info('MCP ListResourceTemplates called'); - var ResultJSON := TJSONObject.Create; + ResultJSON := TJSONObject.Create; try - var ResourceTemplatesArray := TJSONArray.Create; + ResourceTemplatesArray := TJSONArray.Create; ResultJSON.AddPair('resourceTemplates', ResourceTemplatesArray); // Return empty array since this server doesn't support resource templates diff --git a/src/Managers/MCPServer.ToolsManager.pas b/src/Managers/MCPServer.ToolsManager.pas index 2961a6a..7dd119a 100644 --- a/src/Managers/MCPServer.ToolsManager.pas +++ b/src/Managers/MCPServer.ToolsManager.pas @@ -82,15 +82,21 @@ procedure TMCPToolsManager.RegisterTool(const Tool: IMCPTool); end; procedure TMCPToolsManager.RegisterBuiltInTools; +var + Tool: IMCPTool; + ToolName: string; begin - for var ToolName in TMCPRegistry.GetToolNames do + for ToolName in TMCPRegistry.GetToolNames do begin - var Tool := TMCPRegistry.CreateTool(ToolName); + Tool := TMCPRegistry.CreateTool(ToolName); RegisterTool(Tool); end; end; function TMCPToolsManager.ExtractToolNameAndArguments(const Params: System.JSON.TJSONObject; out ToolName: string; out Arguments: TJSONObject): Boolean; +var + ArgsValue: TJSONValue; + NameValue: TJSONValue; begin Result := False; ToolName := ''; @@ -99,14 +105,14 @@ function TMCPToolsManager.ExtractToolNameAndArguments(const Params: System.JSON. if not Assigned(Params) then Exit; - var NameValue := Params.GetValue('name'); + NameValue := Params.GetValue('name'); if Assigned(NameValue) then begin ToolName := NameValue.Value; Result := ToolName <> ''; end; - var ArgsValue := Params.GetValue('arguments'); + ArgsValue := Params.GetValue('arguments'); if Assigned(ArgsValue) and (ArgsValue is TJSONObject) then Arguments := ArgsValue as TJSONObject; end; @@ -122,39 +128,57 @@ function TMCPToolsManager.ExecuteTool(const Tool: IMCPTool; const Arguments: TJS end; function TMCPToolsManager.BuildToolCallResponse(const ResultValue: TValue): TJSONObject; +var + ContentArray: TJSONArray; + ContentItem: TJSONObject; + ErrorValue: TJSONValue; + HasError: Boolean; + JsonResult: TJSONObject; + TextValue: string; begin Result := TJSONObject.Create; if ResultValue.IsType then begin - var TextValue := ResultValue.AsString; - var HasError := TextValue.StartsWith('Error:') or TextValue.StartsWith('Error executing tool:'); + TextValue := ResultValue.AsString; + HasError := TextValue.StartsWith('Error:') or TextValue.StartsWith('Error executing tool:'); - var ContentArray := TJSONArray.Create; + ContentArray := TJSONArray.Create; Result.AddPair('content', ContentArray); - var ContentItem := TJSONObject.Create; + ContentItem := TJSONObject.Create; ContentArray.AddElement(ContentItem); ContentItem.AddPair('type', 'text'); ContentItem.AddPair('text', TextValue); if HasError then +{$IF COMPILERVERSION <= 29} + Result.AddPair('isError', TJSONTrue.Create); +{$ELSE} Result.AddPair('isError', TJSONBool.Create(True)); +{$ENDIF} end else if ResultValue.IsType then begin - var JsonResult := ResultValue.AsType; + JsonResult := ResultValue.AsType; Result.AddPair('structuredContent', TJSONObject(JsonResult.Clone)); - var ErrorValue := JsonResult.GetValue('error'); - var HasError := Assigned(ErrorValue) and (ErrorValue.Value <> ''); + ErrorValue := JsonResult.GetValue('error'); + HasError := Assigned(ErrorValue) and (ErrorValue.Value <> ''); if HasError then +{$IF COMPILERVERSION <= 29} + Result.AddPair('isError', TJSONTrue.Create); +{$ELSE} Result.AddPair('isError', TJSONBool.Create(True)); +{$ENDIF} end; end; function TMCPToolsManager.CreateToolJSON(const Tool: IMCPTool): TJSONObject; +var + Schema: TJSONObject; + SchemaClone: TJSONObject; begin Result := TJSONObject.Create; Result.AddPair('name', Tool.Name); @@ -162,17 +186,17 @@ function TMCPToolsManager.CreateToolJSON(const Tool: IMCPTool): TJSONObject; Result.AddPair('title', Tool.Title); Result.AddPair('description', Tool.Description); - var Schema := Tool.InputSchema; + Schema := Tool.InputSchema; if Assigned(Schema) then begin - var SchemaClone := TJSONObject.ParseJSONValue(Schema.ToJSON) as TJSONObject; + SchemaClone := TJSONObject.ParseJSONValue(Schema.ToJSON) as TJSONObject; Result.AddPair('inputSchema', SchemaClone); Schema.Free; end; Schema := Tool.OutputSchema; if Assigned(Schema) then begin - var SchemaClone := TJSONObject.ParseJSONValue(Schema.ToJSON) as TJSONObject; + SchemaClone := TJSONObject.ParseJSONValue(Schema.ToJSON) as TJSONObject; Result.AddPair('outputSchema', SchemaClone); Schema.Free; end; @@ -180,33 +204,36 @@ function TMCPToolsManager.CreateToolJSON(const Tool: IMCPTool): TJSONObject; end; function TMCPToolsManager.BuildToolListResponse: TJSONObject; +var + Tool: IMCPTool; + ToolsArray: TJSONArray; + ToolJSON: TJSONObject; begin Result := TJSONObject.Create; - var ToolsArray := TJSONArray.Create; + ToolsArray := TJSONArray.Create; Result.AddPair('tools', ToolsArray); - - for var Tool in FTools.Values do + + for Tool in FTools.Values do begin - var ToolJSON := CreateToolJSON(Tool); + ToolJSON := CreateToolJSON(Tool); ToolsArray.AddElement(ToolJSON); end; end; function TMCPToolsManager.CallTool(const Params: System.JSON.TJSONObject): TValue; +var + Arguments: TJSONObject; + ResultValue: TValue; + Tool: IMCPTool; + ToolName: string; begin - var ToolName: string; - var Arguments: TJSONObject; - if not ExtractToolNameAndArguments(Params, ToolName, Arguments) then begin Result := TValue.From(BuildToolCallResponse('Error: Invalid tool parameters')); Exit; end; - + TLogger.Info('MCP CallTool called for tool: ' + ToolName); - - var Tool: IMCPTool; - var ResultValue : TValue; if FTools.TryGetValue(ToolName, Tool) then resultValue := ExecuteTool(Tool, Arguments) diff --git a/src/Protocol/MCPServer.JsonRpcProcessor.pas b/src/Protocol/MCPServer.JsonRpcProcessor.pas index 2ede865..a8bac88 100644 --- a/src/Protocol/MCPServer.JsonRpcProcessor.pas +++ b/src/Protocol/MCPServer.JsonRpcProcessor.pas @@ -42,8 +42,10 @@ constructor TMCPJsonRpcProcessor.Create(ManagerRegistry: IMCPManagerRegistry); end; class function TMCPJsonRpcProcessor.ParseJSONRequest(const RequestBody: string): TJSONObject; +var + ParsedValue: TJSONValue; begin - var ParsedValue := TJSONObject.ParseJSONValue(RequestBody); + ParsedValue := TJSONObject.ParseJSONValue(RequestBody); if not Assigned(ParsedValue) then raise Exception.Create('Invalid JSON'); @@ -57,8 +59,10 @@ class function TMCPJsonRpcProcessor.ParseJSONRequest(const RequestBody: string): end; class function TMCPJsonRpcProcessor.ExtractRequestID(JSONRequest: TJSONObject): TValue; +var + IdValue: TJSONValue; begin - var IdValue := JSONRequest.GetValue('id'); + IdValue := JSONRequest.GetValue('id'); if not Assigned(IdValue) then begin Result := TValue.Empty; @@ -98,11 +102,13 @@ class procedure TMCPJsonRpcProcessor.AddRequestIDToResponse(Response: TJSONObjec class function TMCPJsonRpcProcessor.ExecuteMethodCall(ManagerRegistry: IMCPManagerRegistry; const MethodName: string; Params: TJSONObject): TValue; +var + Manager: IMCPCapabilityManager; begin if not Assigned(ManagerRegistry) then raise Exception.Create('Manager registry not initialized'); - var Manager := ManagerRegistry.GetManagerForMethod(MethodName); + Manager := ManagerRegistry.GetManagerForMethod(MethodName); if not Assigned(Manager) then raise Exception.CreateFmt('Method [%s] not found. The method does not exist or is not available.', [MethodName]); @@ -111,10 +117,13 @@ class function TMCPJsonRpcProcessor.ExecuteMethodCall(ManagerRegistry: IMCPManag class function TMCPJsonRpcProcessor.CreateErrorResponse(const RequestID: TValue; ErrorCode: Integer; const ErrorMessage: string): string; +var + ErrorObj: TJSONObject; + JSONResponse: TJSONObject; begin - var JSONResponse := CreateJSONResponse(RequestID); + JSONResponse := CreateJSONResponse(RequestID); try - var ErrorObj := TJSONObject.Create; + ErrorObj := TJSONObject.Create; JSONResponse.AddPair('error', ErrorObj); ErrorObj.AddPair('code', TJSONNumber.Create(ErrorCode)); ErrorObj.AddPair('message', ErrorMessage); @@ -125,26 +134,36 @@ class function TMCPJsonRpcProcessor.CreateErrorResponse(const RequestID: TValue; end; function TMCPJsonRpcProcessor.ProcessRequest(const RequestBody: string; const SessionID: string): string; +var + ErrorCode: Integer; + ExecuteResult: TValue; + JSONRequest: TJSONObject; + JSONResponse: TJSONObject; + MethodName: string; + MethodValue: TJSONValue; + Params: TJSONObject; + ParamsValue: TJSONValue; + RequestID: TValue; begin Result := ''; - var JSONRequest: TJSONObject := nil; - var JSONResponse: TJSONObject := nil; + JSONRequest := nil; + JSONResponse := nil; try try JSONRequest := ParseJSONRequest(RequestBody); - var RequestID := ExtractRequestID(JSONRequest); + RequestID := ExtractRequestID(JSONRequest); - var MethodValue := JSONRequest.GetValue('method'); - var MethodName := ''; + MethodValue := JSONRequest.GetValue('method'); + MethodName := ''; if Assigned(MethodValue) then MethodName := MethodValue.Value; // Notifications (requests without id) should not have a response if RequestID.IsEmpty then begin - if MethodName = 'initialized' then + if MethodName = 'notifications/initialized' then TLogger.Info('MCP Initialized notification received') else TLogger.Info('Notification received: ' + MethodName); @@ -153,12 +172,12 @@ function TMCPJsonRpcProcessor.ProcessRequest(const RequestBody: string; const Se JSONResponse := CreateJSONResponse(RequestID); - var ParamsValue := JSONRequest.GetValue('params'); - var Params: TJSONObject := nil; + ParamsValue := JSONRequest.GetValue('params'); + Params := nil; if Assigned(ParamsValue) and (ParamsValue is TJSONObject) then Params := ParamsValue as TJSONObject; - var ExecuteResult := ExecuteMethodCall(FManagerRegistry, MethodName, Params); + ExecuteResult := ExecuteMethodCall(FManagerRegistry, MethodName, Params); if not ExecuteResult.IsEmpty then begin @@ -177,7 +196,7 @@ function TMCPJsonRpcProcessor.ProcessRequest(const RequestBody: string; const Se begin TLogger.Error('Error processing request: ' + E.Message); - var ErrorCode := JSONRPC_INTERNAL_ERROR; + ErrorCode := JSONRPC_INTERNAL_ERROR; if Pos('not found', E.Message) > 0 then ErrorCode := JSONRPC_METHOD_NOT_FOUND; diff --git a/src/Protocol/MCPServer.Schema.Generator.pas b/src/Protocol/MCPServer.Schema.Generator.pas index 79c6241..56faf22 100644 --- a/src/Protocol/MCPServer.Schema.Generator.pas +++ b/src/Protocol/MCPServer.Schema.Generator.pas @@ -28,34 +28,46 @@ implementation { TMCPSchemaGenerator } class function TMCPSchemaGenerator.GenerateSchema(Cls: TClass): TJSONObject; +var + Attr: TCustomAttribute; + EnumArray: TJSONArray; + JsonName: string; + JsonType: string; + Properties: TJSONObject; + PropSchema: TJSONObject; + RequiredArray: TJSONArray; + RttiContext: TRttiContext; + RttiProp: TRttiProperty; + RttiType: TRttiType; + Value: string; begin Result := TJSONObject.Create; Result.AddPair('type', 'object'); - var Properties := TJSONObject.Create; + Properties := TJSONObject.Create; Result.AddPair('properties', Properties); - var RequiredArray := TJSONArray.Create; + RequiredArray := TJSONArray.Create; - var RttiContext := TRttiContext.Create; + RttiContext := TRttiContext.Create; try - var RttiType := RttiContext.GetType(Cls); + RttiType := RttiContext.GetType(Cls); - for var RttiProp in RttiType.GetProperties do + for RttiProp in RttiType.GetProperties do begin if RttiProp.IsReadable and RttiProp.IsWritable then begin - var JsonName := GetPropertyJsonName(RttiProp, RttiType); + JsonName := GetPropertyJsonName(RttiProp, RttiType); - var PropSchema := TJSONObject.Create; + PropSchema := TJSONObject.Create; Properties.AddPair(JsonName, PropSchema); - var JsonType := GetJsonTypeFromRttiType(RttiProp.PropertyType); + JsonType := GetJsonTypeFromRttiType(RttiProp.PropertyType); PropSchema.AddPair('type', JsonType); if JsonType = 'array' then PropSchema.AddPair('items', TJSONObject.Create); - for var Attr in RttiProp.GetAttributes do + for Attr in RttiProp.GetAttributes do begin if Attr is SchemaDescriptionAttribute then begin @@ -63,8 +75,8 @@ class function TMCPSchemaGenerator.GenerateSchema(Cls: TClass): TJSONObject; end else if Attr is SchemaEnumAttribute then begin - var EnumArray := TJSONArray.Create; - for var Value in SchemaEnumAttribute(Attr).Values do + EnumArray := TJSONArray.Create; + for Value in SchemaEnumAttribute(Attr).Values do EnumArray.Add(Value); PropSchema.AddPair('enum', EnumArray); end; @@ -118,8 +130,10 @@ class function TMCPSchemaGenerator.GetPropertyJsonName(Prop: TRttiProperty; RTyp end; class function TMCPSchemaGenerator.IsRequiredProperty(Prop: TRttiProperty): Boolean; +var + Attr: TCustomAttribute; begin - for var Attr in Prop.GetAttributes do + for Attr in Prop.GetAttributes do begin if Attr is OptionalAttribute then Exit(False); diff --git a/src/Protocol/MCPServer.Serializer.pas b/src/Protocol/MCPServer.Serializer.pas index a77a207..4a3649b 100644 --- a/src/Protocol/MCPServer.Serializer.pas +++ b/src/Protocol/MCPServer.Serializer.pas @@ -74,30 +74,41 @@ class function TMCPSerializer.NormalizeKey(const Name: string): string; end; class function TMCPSerializer.GetJsonValueCaseInsensitive(const Json: TJSONObject; const PropName: string): TJSONValue; +var + Pair: TJSONPair; + PropNorm: string; begin Result := Json.GetValue(PropName); if Assigned(Result) then Exit; - const PropNorm = NormalizeKey(PropName); - for var Pair in Json do + PropNorm := NormalizeKey(PropName); + for Pair in Json do if NormalizeKey(Pair.JsonString.Value) = PropNorm then Exit(Pair.JsonValue); end; class procedure TMCPSerializer.DeserializeObject(Instance: TObject; const Json: TJSONObject); +var + JsonValue: TJSONValue; + KeyName: string; + KnownNorms: TStringList; + Pair: TJSONPair; + PropValue: TValue; + RttiProp: TRttiProperty; + RttiType: TRttiType; begin - var RttiType := FContext.GetType(Instance.ClassType); + RttiType := FContext.GetType(Instance.ClassType); - var KnownNorms := TStringList.Create; + KnownNorms := TStringList.Create; try - for var RttiProp in RttiType.GetProperties do + for RttiProp in RttiType.GetProperties do if RttiProp.IsWritable then KnownNorms.Add(NormalizeKey(RttiProp.Name)); - for var Pair in Json do + for Pair in Json do begin - const KeyName = Pair.JsonString.Value; + KeyName := Pair.JsonString.Value; if KnownNorms.IndexOf(NormalizeKey(KeyName)) < 0 then raise EArgumentException.CreateFmt( 'Unknown parameter "%s". Valid parameters: %s.', @@ -107,17 +118,17 @@ class procedure TMCPSerializer.DeserializeObject(Instance: TObject; const Json: KnownNorms.Free; end; - for var RttiProp in RttiType.GetProperties do + for RttiProp in RttiType.GetProperties do begin if not RttiProp.IsWritable then Continue; - var JsonValue := GetJsonValueCaseInsensitive(Json, RttiProp.Name); + JsonValue := GetJsonValueCaseInsensitive(Json, RttiProp.Name); if not Assigned(JsonValue) then Continue; - var PropValue := ConvertJsonToValue(JsonValue, RttiProp.PropertyType); + PropValue := ConvertJsonToValue(JsonValue, RttiProp.PropertyType); if not PropValue.IsEmpty then begin @@ -129,20 +140,26 @@ class procedure TMCPSerializer.DeserializeObject(Instance: TObject; const Json: end; class procedure TMCPSerializer.Serialize(Obj: TObject; Json: TJSONObject); +var + JsonValue: TJSONValue; + PropName: string; + PropValue: TValue; + RttiProp: TRttiProperty; + RttiType: TRttiType; begin - var RttiType := FContext.GetType(Obj.ClassType); - - for var RttiProp in RttiType.GetProperties do + RttiType := FContext.GetType(Obj.ClassType); + + for RttiProp in RttiType.GetProperties do begin if not RttiProp.IsReadable then Continue; - - var PropName := LowerCase(RttiProp.Name); + + PropName := LowerCase(RttiProp.Name); {$WARN UNSAFE_CAST OFF} - var PropValue := RttiProp.GetValue(Obj); + PropValue := RttiProp.GetValue(Obj); {$WARN UNSAFE_CAST ON} - var JsonValue := ConvertValueToJson(PropValue, RttiProp.PropertyType); + JsonValue := ConvertValueToJson(PropValue, RttiProp.PropertyType); if Assigned(JsonValue) then Json.AddPair(PropName, JsonValue); @@ -150,8 +167,10 @@ class procedure TMCPSerializer.Serialize(Obj: TObject; Json: TJSONObject); end; class function TMCPSerializer.SerializeToString(Obj: TObject): string; +var + Json: TJSONObject; begin - var Json := TJSONObject.Create; + Json := TJSONObject.Create; try Serialize(Obj, Json); Result := Json.ToJSON; @@ -161,6 +180,9 @@ class function TMCPSerializer.SerializeToString(Obj: TObject): string; end; class function TMCPSerializer.ConvertJsonToValue(const JsonValue: TJSONValue; const RttiType: TRttiType): TValue; +var + EnumValue: Integer; + NestedInstance: TObject; begin Result := TValue.Empty; @@ -184,16 +206,25 @@ class function TMCPSerializer.ConvertJsonToValue(const JsonValue: TJSONValue; co if JsonValue is TJSONNumber then Result := (JsonValue as TJSONNumber).AsDouble else +{$IF COMPILERVERSION <= 28} + Result := StrToFloatDef(JsonValue.Value, 0, TFormatSettings.Create('en-US')); +{$ELSE} Result := StrToFloatDef(JsonValue.Value, 0, FormatSettings.Invariant); - +{$ENDIF} + tkString, tkLString, tkWString, tkUString: Result := JsonValue.Value; tkEnumeration: if RttiType.Handle = TypeInfo(Boolean) then begin +{$IF COMPILERVERSION <= 29} + if (JsonValue is TJSONTrue) or (JsonValue is TJSONFalse) then + Result := JsonValue is TJSONTrue +{$ELSE} if JsonValue is TJSONBool then Result := (JsonValue as TJSONBool).AsBoolean +{$ENDIF} else Result := LowerCase(JsonValue.Value) = 'true'; end @@ -203,7 +234,7 @@ class function TMCPSerializer.ConvertJsonToValue(const JsonValue: TJSONValue; co Result := TValue.FromOrdinal(RttiType.Handle, (JsonValue as TJSONNumber).AsInt) else begin - var EnumValue := GetEnumValue(RttiType.Handle, JsonValue.Value); + EnumValue := GetEnumValue(RttiType.Handle, JsonValue.Value); if EnumValue >= 0 then Result := TValue.FromOrdinal(RttiType.Handle, EnumValue) else @@ -214,7 +245,7 @@ class function TMCPSerializer.ConvertJsonToValue(const JsonValue: TJSONValue; co tkClass: if JsonValue is TJSONObject then begin - var NestedInstance := CreateInstanceFromType(RttiType); + NestedInstance := CreateInstanceFromType(RttiType); if Assigned(NestedInstance) then begin DeserializeObject(NestedInstance, JsonValue as TJSONObject); @@ -231,13 +262,16 @@ class function TMCPSerializer.ConvertJsonToValue(const JsonValue: TJSONValue; co end; class function TMCPSerializer.CreateInstanceFromType(const RttiType: TRttiType): TObject; +var + InstanceType: TRttiInstanceType; + MetaClass: TClass; begin Result := nil; if RttiType is TRttiInstanceType then begin - var InstanceType := TRttiInstanceType(RttiType); - var MetaClass := InstanceType.MetaclassType; + InstanceType := TRttiInstanceType(RttiType); + MetaClass := InstanceType.MetaclassType; if Assigned(MetaClass) then Result := MetaClass.Create; @@ -245,6 +279,9 @@ class function TMCPSerializer.CreateInstanceFromType(const RttiType: TRttiType): end; class function TMCPSerializer.ConvertValueToJson(const Value: TValue; const RttiType: TRttiType): TJSONValue; +var + ChildJson: TJSONObject; + Obj: TObject; begin Result := nil; @@ -265,15 +302,21 @@ class function TMCPSerializer.ConvertValueToJson(const Value: TValue; const Rtti Result := TJSONString.Create(Value.AsString); tkEnumeration: - if RttiType.Handle = TypeInfo(Boolean) then - Result := TJSONBool.Create(Value.AsBoolean) - else - Result := TJSONNumber.Create(Value.AsOrdinal); - + begin +{$IF COMPILERVERSION <= 29} + if Value.AsBoolean then + Result := TJSONTrue.Create + else + Result := TJSONFalse.Create; +{$ELSE} + Result := TJSONBool.Create(Value.AsBoolean); +{$ENDIF} + end; + tkClass: if Value.IsObject and (Value.AsObject <> nil) then begin - var Obj := Value.AsObject; + Obj := Value.AsObject; if Obj is TJSONValue then begin @@ -281,7 +324,7 @@ class function TMCPSerializer.ConvertValueToJson(const Value: TValue; const Rtti end else begin - var ChildJson := TJSONObject.Create; + ChildJson := TJSONObject.Create; Serialize(Obj, ChildJson); Result := ChildJson; end; @@ -301,18 +344,24 @@ class function TMCPSerializer.DeserializeArray(RttiType: TRttiType; const JsonAr end; class function TMCPSerializer.DeserializeDynamicArray(const DynArrayType: TRttiDynamicArrayType; const JsonArray: TJSONArray): TValue; +var + ArrayLength: NativeInt; + ElementType: TRttiType; + ElementValue: TValue; + I: NativeInt; + JsonElement: TJSONValue; begin - var ElementType := DynArrayType.ElementType; - var ArrayLength: NativeInt := JsonArray.Count; + ElementType := DynArrayType.ElementType; + ArrayLength := JsonArray.Count; Result := TValue.Empty; TValue.Make(nil, DynArrayType.Handle, Result); DynArraySetLength(PPointer(Result.GetReferenceToRawData)^, Result.TypeInfo, 1, @ArrayLength); - for var I := 0 to ArrayLength - 1 do + for I := 0 to ArrayLength - 1 do begin - var JsonElement := JsonArray.Items[I]; - var ElementValue := ConvertJsonToValue(JsonElement, ElementType); + JsonElement := JsonArray.Items[Integer(I)]; + ElementValue := ConvertJsonToValue(JsonElement, ElementType); if not ElementValue.IsEmpty then Result.SetArrayElement(I, ElementValue); @@ -320,22 +369,29 @@ class function TMCPSerializer.DeserializeDynamicArray(const DynArrayType: TRttiD end; class function TMCPSerializer.DeserializeGenericList(const ListType: TRttiInstanceType; const JsonArray: TJSONArray): TValue; +var + AddMethod: TRttiMethod; + ElementValue: TValue; + I: Integer; + JsonElement: TJSONValue; + ListInstance: TObject; + ParamType: TRttiType; begin - var ListInstance := ListType.MetaclassType.Create; + ListInstance := ListType.MetaclassType.Create; - var AddMethod := FindAddMethod(ListType); + AddMethod := FindAddMethod(ListType); if not Assigned(AddMethod) then begin ListInstance.Free; Exit(TValue.Empty); end; - var ParamType := AddMethod.GetParameters[0].ParamType; + ParamType := AddMethod.GetParameters[0].ParamType; - for var I := 0 to JsonArray.Count - 1 do + for I := 0 to JsonArray.Count - 1 do begin - var JsonElement := JsonArray.Items[I]; - var ElementValue := ConvertJsonToValue(JsonElement, ParamType); + JsonElement := JsonArray.Items[I]; + ElementValue := ConvertJsonToValue(JsonElement, ParamType); if not ElementValue.IsEmpty then AddMethod.Invoke(ListInstance, [ElementValue]); @@ -345,10 +401,12 @@ class function TMCPSerializer.DeserializeGenericList(const ListType: TRttiInstan end; class function TMCPSerializer.FindAddMethod(const ListType: TRttiInstanceType): TRttiMethod; +var + Method: TRttiMethod; begin Result := nil; - for var Method in ListType.GetMethods do + for Method in ListType.GetMethods do begin if SameText(Method.Name, 'Add') and (Length(Method.GetParameters) = 1) then begin diff --git a/src/Protocol/MCPServer.Types.pas b/src/Protocol/MCPServer.Types.pas index 5ebfff9..df0641f 100644 --- a/src/Protocol/MCPServer.Types.pas +++ b/src/Protocol/MCPServer.Types.pas @@ -123,10 +123,12 @@ constructor SchemaDescriptionAttribute.Create(const ADescription: string); { SchemaEnumAttribute } constructor SchemaEnumAttribute.Create(const AValues: array of string); +var + I: NativeInt; begin inherited Create; SetLength(FValues, Length(AValues)); - for var I := 0 to High(AValues) do + for I := 0 to High(AValues) do FValues[I] := AValues[I]; end; diff --git a/src/Resources/MCPServer.Resource.Base.pas b/src/Resources/MCPServer.Resource.Base.pas index 7887533..09aa327 100644 --- a/src/Resources/MCPServer.Resource.Base.pas +++ b/src/Resources/MCPServer.Resource.Base.pas @@ -90,8 +90,11 @@ function TMCPResourceBase.GetMimeType: string; function TMCPResourceBase.Read: string; var - ResourceData: T; + Ctx: TRttiContext; JSONObj: TJSONObject; + Prop: TRttiProperty; + ResourceData: T; + Typ: TRttiType; begin ResourceData := GetResourceData; try @@ -109,10 +112,10 @@ function TMCPResourceBase.Read: string; end else begin - var Ctx := TRttiContext.Create; + Ctx := TRttiContext.Create; try - var Typ := Ctx.GetType(ResourceData.ClassType); - var Prop := Typ.GetProperty('Content'); + Typ := Ctx.GetType(ResourceData.ClassType); + Prop := Typ.GetProperty('Content'); if Assigned(Prop) then begin {$WARN UNSAFE_CAST OFF} diff --git a/src/Resources/MCPServer.Resource.Logs.pas b/src/Resources/MCPServer.Resource.Logs.pas index aeb2054..cb5f02f 100644 --- a/src/Resources/MCPServer.Resource.Logs.pas +++ b/src/Resources/MCPServer.Resource.Logs.pas @@ -28,15 +28,15 @@ TLogEntry = class TLogEntries = class private FEntries: TObjectList; - FTotalCount: Integer; - FFilteredCount: Integer; + FTotalCount: NativeInt; + FFilteredCount: NativeInt; public constructor Create; destructor Destroy; override; property Entries: TObjectList read FEntries write FEntries; - property TotalCount: Integer read FTotalCount write FTotalCount; - property FilteredCount: Integer read FFilteredCount write FFilteredCount; + property TotalCount: NativeInt read FTotalCount write FTotalCount; + property FilteredCount: NativeInt read FFilteredCount write FFilteredCount; end; TLogBuffer = class @@ -53,7 +53,7 @@ TLogBuffer = class class procedure Finalize; procedure AddLog(const ALevel, AMessage, ACategory: string); - function GetLogs(AMaxCount: Integer = 100; const ALevel: string = ''): TObjectList; + function GetLogs(AMaxCount: NativeInt = 100; const ALevel: string = ''): TObjectList; end; TLogsRecentResource = class(TMCPResourceBase) @@ -157,11 +157,11 @@ procedure TLogBuffer.AddLog(const ALevel, AMessage, ACategory: string); end; end; -function TLogBuffer.GetLogs(AMaxCount: Integer; const ALevel: string): TObjectList; +function TLogBuffer.GetLogs(AMaxCount: NativeInt; const ALevel: string): TObjectList; var - i: Integer; + i: NativeInt; Entry, NewEntry: TLogEntry; - StartIndex: Integer; + StartIndex: NativeInt; begin Result := TObjectList.Create(True); diff --git a/src/Resources/MCPServer.Resource.Project.pas b/src/Resources/MCPServer.Resource.Project.pas index 5afd449..c719540 100644 --- a/src/Resources/MCPServer.Resource.Project.pas +++ b/src/Resources/MCPServer.Resource.Project.pas @@ -123,32 +123,32 @@ function TProjectReadmeResource.GetResourceData: TTextContent; begin Result := TTextContent.Create; - Result.Content := ''' -# Delphi MCP Server - -A Model Context Protocol (MCP) server implementation in Delphi using Indy HTTP Server. - -## Features -- Tools capability with automatic schema generation -- Resources capability for read-only data access -- JSON-RPC 2.0 protocol support -- CORS support for cross-origin requests - -## Building -```bash -build.bat -``` - -## Running -```bash -Win32\Debug\MCPServer.exe -``` - -## Testing -```bash -npx @wong2/mcp-cli --url http://localhost:8080/mcp -``` -'''; + Result.Content := '' + sLineBreak + +'# Delphi MCP Server' + sLineBreak + +'' + sLineBreak + +'A Model Context Protocol (MCP) server implementation in Delphi using Indy HTTP Server.' + sLineBreak + +'' + sLineBreak + +'## Features' + sLineBreak + +'- Tools capability with automatic schema generation' + sLineBreak + +'- Resources capability for read-only data access' + sLineBreak + +'- JSON-RPC 2.0 protocol support' + sLineBreak + +'- CORS support for cross-origin requests' + sLineBreak + +'' + sLineBreak + +'## Building' + sLineBreak + +'```bash' + sLineBreak + +'build.bat' + sLineBreak + +'```' + sLineBreak + +'' + sLineBreak + +'## Running' + sLineBreak + +'```bash' + sLineBreak + +'Win32\Debug\MCPServer.exe' + sLineBreak + +'```' + sLineBreak + +'' + sLineBreak + +'## Testing' + sLineBreak + +'```bash' + sLineBreak + +'npx @wong2/mcp-cli --url http://localhost:8080/mcp' + sLineBreak + +'```' + sLineBreak + +''''; end; diff --git a/src/Resources/MCPServer.Resource.Server.pas b/src/Resources/MCPServer.Resource.Server.pas index 93d19a5..f627f37 100644 --- a/src/Resources/MCPServer.Resource.Server.pas +++ b/src/Resources/MCPServer.Resource.Server.pas @@ -15,7 +15,7 @@ TServerStatus = class FUptime: Int64; FStartTime: TDateTime; FCurrentTime: TDateTime; - FMemoryUsed: Int64; + FMemoryUsed: UInt64; FRequestCount: Int64; FActiveConnections: Integer; public @@ -23,7 +23,7 @@ TServerStatus = class property Uptime: Int64 read FUptime write FUptime; property StartTime: TDateTime read FStartTime write FStartTime; property CurrentTime: TDateTime read FCurrentTime write FCurrentTime; - property MemoryUsed: Int64 read FMemoryUsed write FMemoryUsed; + property MemoryUsed: UInt64 read FMemoryUsed write FMemoryUsed; property RequestCount: Int64 read FRequestCount write FRequestCount; property ActiveConnections: Integer read FActiveConnections write FActiveConnections; end; @@ -76,8 +76,9 @@ class procedure TServerStatusResource.SetNamePrefix(const Prefix: string); end; class procedure TServerStatusResource.RegisterServerStatusResource; +var + URI: string; begin - var URI: string; if FNamePrefix <> '' then URI := 'server://' + FNamePrefix + 'status' else diff --git a/src/Server/MCPServer.IdHTTPServer.pas b/src/Server/MCPServer.IdHTTPServer.pas index 431a9b1..a341340 100644 --- a/src/Server/MCPServer.IdHTTPServer.pas +++ b/src/Server/MCPServer.IdHTTPServer.pas @@ -171,6 +171,8 @@ procedure TMCPIdHTTPServer.Stop; procedure TMCPIdHTTPServer.HandleHTTPRequest(Context: TIdContext; RequestInfo: TIdHTTPRequestInfo; ResponseInfo: TIdHTTPResponseInfo); +var + RequestPath: string; begin TServerStatusResource.ConnectionOpened; try @@ -179,7 +181,7 @@ procedure TMCPIdHTTPServer.HandleHTTPRequest(Context: TIdContext; if not VerifyAndSetCORSHeaders(RequestInfo, ResponseInfo) then Exit; // CORS blocked the request - var RequestPath := RequestInfo.Document; + RequestPath := RequestInfo.Document; // Only handle requests to the configured MCP endpoint if (RequestPath <> FSettings.Endpoint) then @@ -207,23 +209,29 @@ procedure TMCPIdHTTPServer.HandleHTTPRequest(Context: TIdContext; function TMCPIdHTTPServer.VerifyAndSetCORSHeaders(RequestInfo: TIdHTTPRequestInfo; ResponseInfo: TIdHTTPResponseInfo): Boolean; +var + AllowedOrigin: string; + CurrentOrigin: string; + Found: Boolean; + Origin: string; + OriginsList: TStringList; begin Result := True; if not Assigned(FSettings) or not FSettings.CorsEnabled then Exit; - var Origin := RequestInfo.RawHeaders.Values['Origin']; - var AllowedOrigin: string := '*'; + Origin := RequestInfo.RawHeaders.Values['Origin']; + AllowedOrigin := '*'; if (FSettings.CorsAllowedOrigins <> '*') and (Origin <> '') then begin - var OriginsList := TStringList.Create; + OriginsList := TStringList.Create; try OriginsList.CommaText := FSettings.CorsAllowedOrigins; - var Found := False; + Found := False; - for var CurrentOrigin in OriginsList do + for CurrentOrigin in OriginsList do begin if SameText(Trim(CurrentOrigin), Origin) then begin @@ -261,8 +269,11 @@ procedure TMCPIdHTTPServer.HandleOptionsRequest(ResponseInfo: TIdHTTPResponseInf procedure TMCPIdHTTPServer.HandleGetRequest(RequestInfo: TIdHTTPRequestInfo; ResponseInfo: TIdHTTPResponseInfo); +var + AcceptHeader: string; + SessionID: string; begin - var AcceptHeader := RequestInfo.RawHeaders.Values['Accept']; + AcceptHeader := RequestInfo.RawHeaders.Values['Accept']; if AcceptsSSE(AcceptHeader) then begin @@ -274,7 +285,7 @@ procedure TMCPIdHTTPServer.HandleGetRequest(RequestInfo: TIdHTTPRequestInfo; ResponseInfo.CustomHeaders.Values['Connection'] := 'keep-alive'; ResponseInfo.CustomHeaders.Values['X-Accel-Buffering'] := 'no'; - var SessionID := RequestInfo.RawHeaders.Values['Mcp-Session-Id']; + SessionID := RequestInfo.RawHeaders.Values['Mcp-Session-Id']; if SessionID <> '' then ResponseInfo.CustomHeaders.Values['Mcp-Session-Id'] := SessionID; @@ -303,8 +314,13 @@ procedure TMCPIdHTTPServer.HandleGetRequest(RequestInfo: TIdHTTPRequestInfo; procedure TMCPIdHTTPServer.HandlePostRequest(RequestInfo: TIdHTTPRequestInfo; ResponseInfo: TIdHTTPResponseInfo); +var + AcceptHeader: string; + JSONRequest: TJSONValue; + RequestBody: string; + SessionID: string; begin - var RequestBody := ''; + RequestBody := ''; if Assigned(RequestInfo.PostStream) and (RequestInfo.PostStream.Size > 0) then begin RequestInfo.PostStream.Position := 0; @@ -313,13 +329,13 @@ procedure TMCPIdHTTPServer.HandlePostRequest(RequestInfo: TIdHTTPRequestInfo; TLogger.Info('Request: ' + RequestBody); - var SessionID := RequestInfo.RawHeaders.Values['Mcp-Session-Id']; + SessionID := RequestInfo.RawHeaders.Values['Mcp-Session-Id']; if SessionID <> '' then TLogger.Info('Session ID from header: ' + SessionID); - var AcceptHeader := RequestInfo.RawHeaders.Values['Accept']; + AcceptHeader := RequestInfo.RawHeaders.Values['Accept']; - var JSONRequest: TJSONValue := nil; + JSONRequest := nil; try JSONRequest := TJSONObject.ParseJSONValue(RequestBody); @@ -408,14 +424,22 @@ function TMCPIdHTTPServer.AcceptsSSE(const AcceptHeader: string): Boolean; end; function TMCPIdHTTPServer.IsRequestOnlyNotificationsOrResponses(JSONRequest: TJSONValue): Boolean; +var + Arr: TJSONArray; + ErrorValue: TJSONValue; + I: Integer; + IdValue: TJSONValue; + MethodValue: TJSONValue; + Obj: TJSONObject; + ResultValue: TJSONValue; begin if JSONRequest is TJSONObject then begin - var Obj := JSONRequest as TJSONObject; - var MethodValue := Obj.GetValue('method'); - var IdValue := Obj.GetValue('id'); - var ResultValue := Obj.GetValue('result'); - var ErrorValue := Obj.GetValue('error'); + Obj := JSONRequest as TJSONObject; + MethodValue := Obj.GetValue('method'); + IdValue := Obj.GetValue('id'); + ResultValue := Obj.GetValue('result'); + ErrorValue := Obj.GetValue('error'); if Assigned(MethodValue) and not Assigned(IdValue) then Exit(True); @@ -427,9 +451,9 @@ function TMCPIdHTTPServer.IsRequestOnlyNotificationsOrResponses(JSONRequest: TJS end else if JSONRequest is TJSONArray then begin - var Arr := JSONRequest as TJSONArray; + Arr := JSONRequest as TJSONArray; Result := True; - for var I := 0 to Arr.Count - 1 do + for I := 0 to Arr.Count - 1 do begin if not IsRequestOnlyNotificationsOrResponses(Arr.Items[I]) then begin @@ -444,6 +468,10 @@ function TMCPIdHTTPServer.IsRequestOnlyNotificationsOrResponses(JSONRequest: TJS procedure TMCPIdHTTPServer.HandlePostRequestSSE(RequestInfo: TIdHTTPRequestInfo; ResponseInfo: TIdHTTPResponseInfo; const RequestBody: string; const SessionID: string); +var + EventID: string; + JSONResponse: string; + SSEMessage: string; begin TLogger.Info('Handling POST request with SSE stream'); @@ -456,12 +484,12 @@ procedure TMCPIdHTTPServer.HandlePostRequestSSE(RequestInfo: TIdHTTPRequestInfo; if SessionID <> '' then ResponseInfo.CustomHeaders.Values['Mcp-Session-Id'] := SessionID; - var JSONResponse := FJsonRpcProcessor.ProcessRequest(RequestBody, SessionID); + JSONResponse := FJsonRpcProcessor.ProcessRequest(RequestBody, SessionID); if JSONResponse <> '' then begin - var EventID := GetNextEventID; - var SSEMessage := ''; + EventID := GetNextEventID; + SSEMessage := ''; if EventID <> '' then SSEMessage := SSEMessage + SSE_ID_PREFIX + EventID + #10; @@ -482,10 +510,15 @@ procedure TMCPIdHTTPServer.HandlePostRequestSSE(RequestInfo: TIdHTTPRequestInfo; procedure TMCPIdHTTPServer.HandlePostRequestJSON(RequestInfo: TIdHTTPRequestInfo; ResponseInfo: TIdHTTPResponseInfo; const RequestBody: string; const SessionID: string); +var + ResponseBody: string; + ResponseJSON: TJSONObject; + ResultObj: TJSONObject; + SessionValue: TJSONValue; begin TLogger.Info('Handling POST request with JSON response'); - var ResponseBody := FJsonRpcProcessor.ProcessRequest(RequestBody, SessionID); + ResponseBody := FJsonRpcProcessor.ProcessRequest(RequestBody, SessionID); if ResponseBody = '' then begin @@ -498,12 +531,12 @@ procedure TMCPIdHTTPServer.HandlePostRequestJSON(RequestInfo: TIdHTTPRequestInfo if (SessionID = '') and (Pos('"sessionId"', ResponseBody) > 0) then begin - var ResponseJSON := TJSONObject.ParseJSONValue(ResponseBody) as TJSONObject; + ResponseJSON := TJSONObject.ParseJSONValue(ResponseBody) as TJSONObject; try - var ResultObj := ResponseJSON.GetValue('result') as TJSONObject; + ResultObj := ResponseJSON.GetValue('result') as TJSONObject; if Assigned(ResultObj) then begin - var SessionValue := ResultObj.GetValue('sessionId'); + SessionValue := ResultObj.GetValue('sessionId'); if Assigned(SessionValue) then ResponseInfo.CustomHeaders.Values['Mcp-Session-Id'] := SessionValue.Value; end; diff --git a/src/Server/MCPServer.StdioTransport.pas b/src/Server/MCPServer.StdioTransport.pas index 88800a9..d49fc6c 100644 --- a/src/Server/MCPServer.StdioTransport.pas +++ b/src/Server/MCPServer.StdioTransport.pas @@ -40,11 +40,15 @@ destructor TMCPStdioTransport.Destroy; end; procedure TMCPStdioTransport.Run; +var + ErrorResponse: string; + InputLine: string; + Response: string; begin TLogger.Info('STDIO transport started - reading from stdin, writing to stdout'); TLogger.Info('Logging to stderr'); - var InputLine := ''; + InputLine := ''; while not Eof(Input) do begin try @@ -55,7 +59,7 @@ procedure TMCPStdioTransport.Run; TLogger.Info('Received: ' + InputLine); - var Response := FJsonRpcProcessor.ProcessRequest(InputLine, ''); + Response := FJsonRpcProcessor.ProcessRequest(InputLine, ''); if Response <> '' then begin @@ -69,7 +73,7 @@ procedure TMCPStdioTransport.Run; begin TLogger.Error('Error processing STDIO request: ' + E.Message); - var ErrorResponse := '{"jsonrpc":"2.0","id":null,"error":{"code":-32603,"message":"' + + ErrorResponse := '{"jsonrpc":"2.0","id":null,"error":{"code":-32603,"message":"' + E.Message.Replace('"', '\"') + '"}}'; Writeln(Output, ErrorResponse); Flush(Output); diff --git a/src/Tools/MCPServer.Tool.ListFiles.pas b/src/Tools/MCPServer.Tool.ListFiles.pas index 649aa9a..8e6e8f3 100644 --- a/src/Tools/MCPServer.Tool.ListFiles.pas +++ b/src/Tools/MCPServer.Tool.ListFiles.pas @@ -46,19 +46,22 @@ constructor TListFilesTool.Create; FDescription := 'List files in a directory'; end; +{$WARN SYMBOL_PLATFORM OFF} function TListFilesTool.ExecuteWithParams(const Params: TListFilesParams): string; var + Attrs: TFileAttributes; Files: TStringList; FileArray: TStringDynArray; FileName: string; NormalizedPath: string; AllowedBasePath: string; +{$WARN SYMBOL_PLATFORM DEFAULT} begin Files := TStringList.Create; try NormalizedPath := TPath.GetFullPath(Params.Path); AllowedBasePath := TPath.GetFullPath(GetCurrentDir); - + if not NormalizedPath.StartsWith(AllowedBasePath, True) then begin Result := 'Error: Access denied - path outside allowed directory'; @@ -73,7 +76,7 @@ function TListFilesTool.ExecuteWithParams(const Params: TListFilesParams): strin {$IFDEF MSWINDOWS} if (not Params.IncludeHidden) then begin - var Attrs := TFile.GetAttributes(FileName); + Attrs := TFile.GetAttributes(FileName); {$WARN SYMBOL_PLATFORM OFF} if (TFileAttribute.faHidden in Attrs) then Continue;