···
5
+
let src = Logs.Src.create "mcp.sdk" ~doc:"mcp.sdk logging"
7
+
module Log = (val Logs.src_log src : Logs.LOG)
(* Create a proper JSONRPC error with code and data *)
let create_jsonrpc_error id code message ?data () =
let error_code = ErrorCode.to_int code in
···
(* Process initialize request *)
let handle_initialize server req =
13
-
Log.debug "Processing initialize request";
17
+
Log.debug (fun m -> m "Processing initialize request");
match req.JSONRPCMessage.params with
let req_data = Initialize.Request.t_of_yojson params in
18
-
Log.debugf "Client info: %s v%s" req_data.client_info.name
19
-
req_data.client_info.version;
20
-
Log.debugf "Client protocol version: %s" req_data.protocol_version;
22
+
Logs.debug (fun m ->
23
+
m "Client info: %s v%s" req_data.client_info.name
24
+
req_data.client_info.version);
26
+
m "Client protocol version: %s" req_data.protocol_version);
(* Create initialize response *)
···
Initialize.Result.yojson_of_t result
34
-
Log.error "Missing params for initialize request";
40
+
Log.err (fun m -> m "Missing params for initialize request");
`Assoc [ ("error", `String "Missing params for initialize request") ]
Some (create_response ~id:req.id ~result)
(* Process tools/list request *)
let handle_tools_list server (req : JSONRPCMessage.request) =
41
-
Log.debug "Processing tools/list request";
47
+
Log.debug (fun m -> m "Processing tools/list request");
let tools_list = Tool.to_rpc_tools_list (tools server) in
Mcp_rpc.ToolsList.create_response ~id:req.id ~tools:tools_list ()
···
(* Process prompts/list request *)
let handle_prompts_list server (req : JSONRPCMessage.request) =
50
-
Log.debug "Processing prompts/list request";
56
+
Log.debug (fun m -> m "Processing prompts/list request");
let prompts_list = Prompt.to_rpc_prompts_list (prompts server) in
Mcp_rpc.PromptsList.create_response ~id:req.id ~prompts:prompts_list ()
···
(* Process resources/list request *)
let handle_resources_list server (req : JSONRPCMessage.request) =
59
-
Log.debug "Processing resources/list request";
65
+
Log.debug (fun m -> m "Processing resources/list request");
let resources_list = Resource.to_rpc_resources_list (resources server) in
Mcp_rpc.ResourcesList.create_response ~id:req.id ~resources:resources_list
···
(* Process resources/templates/list request *)
let handle_resource_templates_list server (req : JSONRPCMessage.request) =
69
-
Log.debug "Processing resources/templates/list request";
75
+
Log.debug (fun m -> m "Processing resources/templates/list request");
ResourceTemplate.to_rpc_resource_templates_list (resource_templates server)
···
(* Process resources/read request *)
let handle_resources_read server (req : JSONRPCMessage.request) =
147
-
Log.debug "Processing resources/read request";
153
+
Log.debug (fun m -> m "Processing resources/read request");
match req.JSONRPCMessage.params with
150
-
Log.error "Missing params for resources/read request";
156
+
Log.err (fun m -> m "Missing params for resources/read request");
(create_jsonrpc_error req.id ErrorCode.InvalidParams
"Missing params for resources/read request" ())
let req_data = Mcp_rpc.ResourcesRead.Request.t_of_yojson params in
let uri = req_data.uri in
157
-
Log.debugf "Resource URI: %s" uri;
163
+
Log.debug (fun m -> m "Resource URI: %s" uri);
(* Find matching resource or template *)
match Resource_matcher.find_match server uri with
···
171
-
Log.debugf "Handling direct resource: %s" resource.name;
177
+
Log.debug (fun m -> m "Handling direct resource: %s" resource.name);
(* Call the resource handler *)
match resource.handler ctx params with
···
198
-
Log.errorf "Error reading resource: %s" err;
204
+
Log.err (fun m -> m "Error reading resource: %s" err);
(create_jsonrpc_error req.id ErrorCode.InternalError
("Error reading resource: " ^ err)
···
213
-
Log.debugf "Handling resource template: %s with params: [%s]"
215
-
(String.concat ", " params);
219
+
Log.debug (fun m ->
220
+
m "Handling resource template: %s with params: [%s]" template.name
221
+
(String.concat ", " params));
(* Call the template handler *)
match template.handler ctx params with
···
242
-
Log.errorf "Error reading resource template: %s" err;
248
+
Log.err (fun m -> m "Error reading resource template: %s" err);
(create_jsonrpc_error req.id ErrorCode.InternalError
("Error reading resource template: " ^ err)
| Resource_matcher.NoMatch ->
248
-
Log.errorf "Resource not found: %s" uri;
254
+
Log.err (fun m -> m "Resource not found: %s" uri);
(create_jsonrpc_error req.id ErrorCode.InvalidParams
("Resource not found: " ^ uri)
···
let extract_tool_name params =
match List.assoc_opt "name" params with
258
-
Log.debugf "Tool name: %s" name;
264
+
Log.debug (fun m -> m "Tool name: %s" name);
261
-
Log.error "Missing or invalid 'name' parameter in tool call";
267
+
Log.err (fun m -> m "Missing or invalid 'name' parameter in tool call");
(* Extract the tool arguments from params *)
let extract_tool_arguments params =
match List.assoc_opt "arguments" params with
268
-
Log.debugf "Tool arguments: %s" (Yojson.Safe.to_string args);
274
+
Log.debug (fun m -> m "Tool arguments: %s" (Yojson.Safe.to_string args));
271
-
Log.debug "No arguments provided for tool call, using empty object";
277
+
Log.debug (fun m ->
278
+
m "No arguments provided for tool call, using empty object");
`Assoc [] (* Empty arguments is valid *)
let execute_tool server ctx name args =
let tool = List.find (fun t -> t.Tool.name = name) (tools server) in
278
-
Log.debugf "Found tool: %s" name;
285
+
Log.debug (fun m -> m "Found tool: %s" name);
(* Call the tool handler *)
match tool.handler ctx args with
283
-
Log.debug "Tool execution succeeded";
290
+
Log.debug (fun m -> m "Tool execution succeeded");
| Error err -> Tool.handle_execution_error err
···
(* Process tools/call request *)
let handle_tools_call server req =
314
-
Log.debug "Processing tools/call request";
321
+
Log.debug (fun m -> m "Processing tools/call request");
match req.JSONRPCMessage.params with
| Some (`Assoc params) -> (
match extract_tool_name params with
···
(create_jsonrpc_error req.id InvalidParams
"Missing tool name parameter" ()))
346
-
Log.error "Invalid params format for tools/call";
353
+
Log.err (fun m -> m "Invalid params format for tools/call");
(create_jsonrpc_error req.id InvalidParams
"Invalid params format for tools/call" ())
(* Process ping request *)
let handle_ping (req : JSONRPCMessage.request) =
353
-
Log.debug "Processing ping request";
360
+
Log.debug (fun m -> m "Processing ping request");
Some (create_response ~id:req.JSONRPCMessage.id ~result:(`Assoc []))
(* Handle notifications/initialized *)
let handle_initialized (notif : JSONRPCMessage.notification) =
359
-
"Client initialization complete - Server is now ready to receive requests";
360
-
Log.debugf "Notification params: %s"
361
-
(match notif.JSONRPCMessage.params with
362
-
| Some p -> Yojson.Safe.to_string p
365
+
Log.debug (fun m ->
367
+
"Client initialization complete - Server is now ready to receive \
369
+
\ Notification params: %s"
370
+
(match notif.JSONRPCMessage.params with
371
+
| Some p -> Yojson.Safe.to_string p
372
+
| None -> "null"));
(* Process a single message using the MCP SDK *)
let process_message server message =
369
-
Log.debugf "Processing message: %s" (Yojson.Safe.to_string message);
378
+
Log.debug (fun m ->
379
+
m "Processing message: %s" (Yojson.Safe.to_string message));
match JSONRPCMessage.t_of_yojson message with
| JSONRPCMessage.Request req -> (
372
-
Log.debugf "Received request with method: %s"
373
-
(Method.to_string req.meth);
382
+
Log.debug (fun m ->
383
+
m "Received request with method: %s" (Method.to_string req.meth));
| Method.Initialize -> handle_initialize server req
| Method.ToolsList -> handle_tools_list server req
···
| Method.ResourceTemplatesList ->
handle_resource_templates_list server req
384
-
Log.errorf "Unknown method received: %s" (Method.to_string req.meth);
395
+
m "Unknown method received: %s" (Method.to_string req.meth));
(create_jsonrpc_error req.id ErrorCode.MethodNotFound
("Method not found: " ^ Method.to_string req.meth)
| JSONRPCMessage.Notification notif -> (
390
-
Log.debugf "Received notification with method: %s"
391
-
(Method.to_string notif.meth);
401
+
Log.debug (fun m ->
402
+
m "Received notification with method: %s"
403
+
(Method.to_string notif.meth));
| Method.Initialized -> handle_initialized notif
395
-
Log.debugf "Ignoring notification: %s" (Method.to_string notif.meth);
407
+
Log.debug (fun m ->
408
+
m "Ignoring notification: %s" (Method.to_string notif.meth));
| JSONRPCMessage.Response _ ->
398
-
Log.error "Unexpected response message received";
411
+
Log.err (fun m -> m "Unexpected response message received");
| JSONRPCMessage.Error _ ->
401
-
Log.error "Unexpected error message received";
414
+
Log.err (fun m -> m "Unexpected error message received");
| Json.Of_json (msg, _) ->
405
-
Log.errorf "JSON error: %s" msg;
418
+
Log.err (fun m -> m "JSON error: %s" msg);
(* Can't respond with error because we don't have a request ID *)
| Yojson.Json_error msg ->
409
-
Log.errorf "JSON parse error: %s" msg;
422
+
Log.err (fun m -> m "JSON parse error: %s" msg);
(* Can't respond with error because we don't have a request ID *)
413
-
Log.errorf "Exception during message processing: %s"
414
-
(Printexc.to_string exc);
415
-
Log.errorf "Backtrace: %s" (Printexc.get_backtrace ());
416
-
Log.errorf "Message was: %s" (Yojson.Safe.to_string message);
428
+
"Exception during message processing: %s\n\
431
+
(Printexc.to_string exc)
432
+
(Printexc.get_backtrace ())
433
+
(Yojson.Safe.to_string message));
(* Extract a request ID from a potentially malformed message *)
···
(* Handle processing for an input line *)
let process_input_line server line =
434
-
Log.debug "Empty line received, ignoring";
451
+
Log.debug (fun m -> m "Empty line received, ignoring");
437
-
Log.debugf "Raw input: %s" line;
454
+
Log.debug (fun m -> m "Raw input: %s" line);
let json = Yojson.Safe.from_string line in
440
-
Log.debug "Successfully parsed JSON";
457
+
Log.debug (fun m -> m "Successfully parsed JSON");
(* Process the message *)
process_message server json
with Yojson.Json_error msg ->
445
-
Log.errorf "Error parsing JSON: %s" msg;
446
-
Log.errorf "Input was: %s" line;
462
+
Log.err (fun m -> m "Error parsing JSON: %s" msg);
463
+
Log.err (fun m -> m "Input was: %s" line);
(* Send a response to the client *)
let send_response stdout response =
let response_json = JSONRPCMessage.yojson_of_t response in
let response_str = Yojson.Safe.to_string response_json in
453
-
Log.debugf "Sending response: %s" response_str;
470
+
Log.debug (fun m -> m "Sending response: %s" response_str);
(* Write the response followed by a newline *)
Eio.Flow.copy_string response_str stdout;
···
let callback mcp_server _conn (request : Http.Request.t) body =
463
-
Log.debug "Received POST request";
480
+
Log.debug (fun m -> m "Received POST request");
Eio.Buf_read.(parse_exn take_all) body ~max_size:max_int
···
let response_json = JSONRPCMessage.yojson_of_t mcp_response in
let response_str = Yojson.Safe.to_string response_json in
471
-
Log.debugf "Sending MCP response: %s" response_str;
488
+
Log.debug (fun m -> m "Sending MCP response: %s" response_str);
Http.Header.of_list [ ("Content-Type", "application/json") ]
···
~body:(Cohttp_eio.Body.of_string response_str)
479
-
Log.debug "No MCP response needed";
496
+
Log.debug (fun m -> m "No MCP response needed");
Cohttp_eio.Server.respond ~status:`No_content
~body:(Cohttp_eio.Body.of_string "")
484
-
Log.infof "Unsupported method: %s" (Http.Method.to_string request.meth);
502
+
m "Unsupported method: %s" (Http.Method.to_string request.meth));
Cohttp_eio.Server.respond ~status:`Method_not_allowed
~body:(Cohttp_eio.Body.of_string "Only POST is supported")
···
let net = Eio.Stdenv.net env in
let addr = `Tcp (Eio.Net.Ipaddr.V4.loopback, port) in
496
-
Log.debugf "Starting MCP server: %s v%s" (name server) (version server);
497
-
Log.debugf "Protocol version: %s" (protocol_version server);
515
+
m "Starting http MCP server: %s v%s\nProtocol version: %s" (name server)
516
+
(version server) (protocol_version server));
Eio.Switch.run @@ fun sw ->
let server_spec = Cohttp_eio.Server.make ~callback:(callback server) () in
···
Eio.Net.listen net ~sw ~backlog:128 ~reuse_addr:true addr
505
-
Log.infof "MCP HTTP Server listening on http://localhost:%d" port;
524
+
Log.info (fun m -> m "MCP HTTP Server listening on http://localhost:%d" port);
Cohttp_eio.Server.run server_socket server_spec ~on_error
(** run the server using the stdio transport *)
510
-
let run_sdtio_server env server =
529
+
let run_stdio_server env server =
let stdin = Eio.Stdenv.stdin env in
let stdout = Eio.Stdenv.stdout env in
514
-
Log.debugf "Starting MCP server: %s v%s" (name server) (version server);
515
-
Log.debugf "Protocol version: %s" (protocol_version server);
534
+
m "Starting stdio MCP server: %s v%s\nProtocol version: %s" (name server)
535
+
(version server) (protocol_version server));
(* Enable exception backtraces *)
Printexc.record_backtrace true;
···
(* Main processing loop *)
525
-
Log.debug "Waiting for message...";
545
+
Log.info (fun m -> m "Waiting for message...");
let line = Eio.Buf_read.line buf in
(* Process the input and send response if needed *)
match process_input_line server line with
| Some response -> send_response stdout response
531
-
| None -> Log.debug "No response needed for this message"
551
+
| None -> Log.info (fun m -> m "No response needed for this message")
535
-
Log.debug "End of file received on stdin";
555
+
Log.debug (fun m -> m "End of file received on stdin");
538
-
Log.errorf "I/O error while reading: %s" (Printexc.to_string exn);
558
+
(* Only a warning since on Windows, once the client closes the connection, we normally fail with `I/O error while reading: Eio.Io Net Connection_reset Unix_error (Broken pipe, "stub_cstruct_read", "")` *)
560
+
m "I/O error while reading: %s" (Printexc.to_string exn));
541
-
Log.errorf "Exception while reading: %s" (Printexc.to_string exn);
564
+
m "Exception while reading: %s" (Printexc.to_string exn));
anil.recoil.org
mseri.me