this repo has no description
logging: remove handcrafted logger and replace it with logs
The old one did not allow customization, and using logs will also make this behave like its dependencies.
Signed-off-by: Marcello Seri <marcello.seri@gmail.com>
+142
-165
+3
-3
bin/capitalize_sdk.ml
+3
-3
bin/capitalize_sdk.ml
···
34
34
TextContent.yojson_of_t
35
35
TextContent.{ text = capitalized_text; annotations = None }
36
36
with Failure msg ->
37
-
Log.errorf "Error in capitalize tool: %s" msg;
37
+
Logs.err (fun m -> m "Error in capitalize tool: %s" msg);
38
38
TextContent.yojson_of_t
39
39
TextContent.
40
40
{ text = Printf.sprintf "Error: %s" msg; annotations = None })
···
80
80
])
81
81
82
82
let () =
83
-
(* Run the server with the default scheduler *)
84
-
Eio_main.run @@ fun env -> Mcp_server.run_server env server
83
+
Logs.set_reporter (Logs.format_reporter ());
84
+
Eio_main.run @@ fun env -> Mcp_server.run_stdio_server env server
+4
-3
bin/dune
+4
-3
bin/dune
···
1
1
(executable
2
2
(name capitalize_sdk)
3
3
(modules capitalize_sdk)
4
-
(libraries mcp mcp_server yojson eio_main eio))
4
+
(libraries logs mcp mcp_server yojson eio_main eio))
5
5
6
6
(executable
7
7
(name multimodal_sdk)
8
8
(modules multimodal_sdk)
9
-
(libraries mcp mcp_sdk mcp_server yojson eio_main eio))
9
+
(libraries logs mcp mcp_sdk mcp_server yojson eio_main eio))
10
10
11
11
(executable
12
12
(name ocaml_eval_sdk)
···
15
15
(flags
16
16
(:standard -w -32 -w -33))
17
17
(libraries
18
+
logs
18
19
mcp
19
20
mcp_sdk
20
21
mcp_server
···
26
27
(executable
27
28
(name markdown_book_sdk)
28
29
(modules markdown_book_sdk)
29
-
(libraries mcp mcp_sdk mcp_server yojson eio_main eio))
30
+
(libraries logs mcp mcp_sdk mcp_server yojson eio_main eio))
+20
-20
bin/markdown_book_sdk.ml
+20
-20
bin/markdown_book_sdk.ml
···
99
99
100
100
```ocaml
101
101
(* If expression *)
102
-
let abs x =
102
+
let abs x =
103
103
if x < 0 then -x else x
104
104
105
105
(* Match expression (pattern matching) *)
···
308
308
let pi = 3.14159
309
309
let square x = x *. x
310
310
let cube x = x *. x *. x
311
-
311
+
312
312
(* This is hidden because it's not in the signature *)
313
313
let private_helper x = x +. 1.0
314
314
end
···
330
330
(* Functor that creates a set implementation given an element type with comparison *)
331
331
module MakeSet (Element : sig type t val compare : t -> t -> int end) : COLLECTION with type 'a t = Element.t list = struct
332
332
type 'a t = Element.t list
333
-
333
+
334
334
let empty = []
335
-
335
+
336
336
let rec add x lst =
337
337
match lst with
338
338
| [] -> [x]
···
341
341
if c < 0 then x :: lst
342
342
else if c = 0 then lst (* Element already exists *)
343
343
else y :: add x ys
344
-
344
+
345
345
let rec mem x lst =
346
346
match lst with
347
347
| [] -> false
···
459
459
| `Circle r -> Float.pi *. r *. r
460
460
| `Rectangle (w, h) -> w *. h
461
461
| `Triangle (b, h) -> 0.5 *. b *. h
462
-
| `Regular_polygon(n, s) when n >= 3 ->
462
+
| `Regular_polygon(n, s) when n >= 3 ->
463
463
let apothem = s /. (2.0 *. tan (Float.pi /. float_of_int n)) in
464
464
n *. s *. apothem /. 2.0
465
465
| _ -> failwith "Invalid shape"
···
475
475
object (self)
476
476
val mutable x = x_init
477
477
val mutable y = y_init
478
-
478
+
479
479
method get_x = x
480
480
method get_y = y
481
481
method move dx dy = x <- x + dx; y <- y + dy
482
-
method distance_from_origin =
482
+
method distance_from_origin =
483
483
sqrt (float_of_int (x * x + y * y))
484
-
484
+
485
485
(* Private method *)
486
-
method private to_string =
486
+
method private to_string =
487
487
Printf.sprintf "(%d, %d)" x y
488
-
488
+
489
489
(* Calling another method *)
490
490
method print = print_endline self#to_string
491
491
end
···
554
554
(* Handler for the Ask effect *)
555
555
let prompt_user () =
556
556
Effect.Deep.try_with
557
-
(fun () ->
557
+
(fun () ->
558
558
let name = Effect.perform (Ask "What is your name?") in
559
559
Printf.printf "Hello, %s!\n" name)
560
560
{ Effect.Deep.effc = fun (type a) (effect : a Effect.t) ->
···
605
605
} [@@deriving sexp]
606
606
607
607
(* With ppx_let for monadic operations *)
608
-
let computation =
608
+
let computation =
609
609
[%m.let
610
610
let* x = get_value_from_db "key1" in
611
611
let* y = get_value_from_db "key2" in
···
621
621
(* Phantom types for added type safety *)
622
622
module SafeString : sig
623
623
type 'a t
624
-
624
+
625
625
(* Constructors for different string types *)
626
626
val of_raw : string -> [`Raw] t
627
627
val sanitize : [`Raw] t -> [`Sanitized] t
628
628
val validate : [`Sanitized] t -> [`Validated] t option
629
-
629
+
630
630
(* Operations that require specific string types *)
631
631
val to_html : [`Sanitized] t -> string
632
632
val to_sql : [`Validated] t -> string
633
-
633
+
634
634
(* Common operations for all string types *)
635
635
val length : _ t -> int
636
636
val concat : _ t -> _ t -> [`Raw] t
637
637
end = struct
638
638
type 'a t = string
639
-
639
+
640
640
let of_raw s = s
641
641
let sanitize s = String.map (function '<' | '>' -> '_' | c -> c) s
642
642
let validate s = if String.length s > 0 then Some s else None
643
-
643
+
644
644
let to_html s = s
645
645
let to_sql s = "'" ^ String.map (function '\'' -> '\'' | c -> c) s ^ "'"
646
-
646
+
647
647
let length = String.length
648
648
let concat s1 s2 = s1 ^ s2
649
649
end
···
718
718
content)
719
719
720
720
(* Run the server with the default scheduler *)
721
-
let () = Eio_main.run @@ fun env -> Mcp_server.run_server env server
721
+
let () = Eio_main.run @@ fun env -> Mcp_server.run_stdio_server env server
+5
-4
bin/multimodal_sdk.ml
+5
-4
bin/multimodal_sdk.ml
···
313
313
]
314
314
~is_error:false
315
315
with Failure msg ->
316
-
Log.errorf "Error in multimodal tool: %s" msg;
316
+
Logs.err (fun m -> m "Error in multimodal tool: %s" msg);
317
317
Tool.create_tool_result
318
318
[ Mcp.make_text_content (Printf.sprintf "Error: %s" msg) ]
319
319
~is_error:true)
···
346
346
[ Mcp.make_image_content image_data "image/gif" ]
347
347
~is_error:false
348
348
with Failure msg ->
349
-
Log.errorf "Error in generate_image tool: %s" msg;
349
+
Logs.err (fun m -> m "Error in generate_image tool: %s" msg);
350
350
Tool.create_tool_result
351
351
[ Mcp.make_text_content (Printf.sprintf "Error: %s" msg) ]
352
352
~is_error:true)
···
388
388
[ Mcp.make_audio_content audio_data "audio/wav" ]
389
389
~is_error:false
390
390
with Failure msg ->
391
-
Log.errorf "Error in generate_audio tool: %s" msg;
391
+
Logs.err (fun m -> m "Error in generate_audio tool: %s" msg);
392
392
Tool.create_tool_result
393
393
[ Mcp.make_text_content (Printf.sprintf "Error: %s" msg) ]
394
394
~is_error:true)
···
427
427
428
428
(* Run the server with the default scheduler *)
429
429
let () =
430
+
Logs.set_reporter (Logs.format_reporter ());
430
431
Random.self_init ();
431
432
(* Initialize random generator *)
432
-
Eio_main.run @@ fun env -> Mcp_server.run_server env server
433
+
Eio_main.run @@ fun env -> Mcp_server.run_stdio_server env server
+4
-2
bin/ocaml_eval_sdk.ml
+4
-2
bin/ocaml_eval_sdk.ml
···
150
150
[ Mcp.make_text_content output ]
151
151
~is_error:(not success)
152
152
with Failure msg ->
153
-
Log.errorf "Error in OCaml eval tool: %s" msg;
153
+
Logs.err (fun m -> m "Error in OCaml eval tool: %s" msg);
154
154
Tool.create_tool_result
155
155
[ Mcp.make_text_content (Printf.sprintf "Error: %s" msg) ]
156
156
~is_error:true)
157
157
158
158
(* Run the server with the default scheduler *)
159
-
let () = Eio_main.run @@ fun env -> Mcp_server.run_server env server
159
+
let () =
160
+
Logs.set_reporter (Logs.format_reporter ());
161
+
Eio_main.run @@ fun env -> Mcp_server.run_stdio_server env server
+2
-3
dune-project
+2
-3
dune-project
+1
-1
lib/dune
+1
-1
lib/dune
+8
-35
lib/mcp_sdk.ml
+8
-35
lib/mcp_sdk.ml
···
3
3
4
4
(* SDK version *)
5
5
let version = "0.1.0"
6
-
7
-
(* Logging utilities *)
8
-
module Log = struct
9
-
type level = Debug | Info | Warning | Error
10
-
11
-
let string_of_level = function
12
-
| Debug -> "DEBUG"
13
-
| Info -> "INFO"
14
-
| Warning -> "WARNING"
15
-
| Error -> "ERROR"
16
-
17
-
let logf level fmt =
18
-
Printf.fprintf stderr "[%s] " (string_of_level level);
19
-
Printf.kfprintf
20
-
(fun oc ->
21
-
Printf.fprintf oc "\n";
22
-
flush oc)
23
-
stderr fmt
24
-
25
-
let debugf fmt = logf Debug fmt
26
-
let infof fmt = logf Info fmt
27
-
let warningf fmt = logf Warning fmt
28
-
let errorf fmt = logf Error fmt
6
+
let src = Logs.Src.create "mcp.sdk" ~doc:"mcp.sdk logging"
29
7
30
-
(* Backward compatibility functions that take a simple string *)
31
-
let log level msg = logf level "%s" msg
32
-
let debug msg = debugf "%s" msg
33
-
let info msg = infof "%s" msg
34
-
let warning msg = warningf "%s" msg
35
-
let error msg = errorf "%s" msg
36
-
end
8
+
module Log = (val Logs.src_log src : Logs.LOG)
37
9
38
10
(* Context for tools and resources *)
39
11
module Context = struct
···
182
154
183
155
(* Create a tool error result with structured content *)
184
156
let create_error_result error =
185
-
Log.errorf "Error result: %s" error;
157
+
Logs.err (fun m -> m "Error result: %s" error);
186
158
create_tool_result [ Mcp.make_text_content error ] ~is_error:true
187
159
188
160
(* Handle tool execution errors *)
···
214
186
let create ~uri ~name ?description ?mime_type ~handler () =
215
187
(* Validate that the URI doesn't contain template variables *)
216
188
if String.contains uri '{' || String.contains uri '}' then
217
-
Log.warningf
218
-
"Resource '%s' contains template variables. Consider using \
219
-
add_resource_template instead."
220
-
uri;
189
+
Logs.warn (fun m ->
190
+
m
191
+
"Resource '%s' contains template variables. Consider using \
192
+
add_resource_template instead."
193
+
uri);
221
194
{ uri; name; description; mime_type; handler }
222
195
223
196
let to_json resource =
-23
lib/mcp_sdk.mli
-23
lib/mcp_sdk.mli
···
6
6
val version : string
7
7
(** SDK version *)
8
8
9
-
(** Logging utilities *)
10
-
module Log : sig
11
-
type level = Debug | Info | Warning | Error
12
-
13
-
val string_of_level : level -> string
14
-
15
-
val logf : level -> ('a, out_channel, unit) format -> 'a
16
-
(** Format-string based logging functions *)
17
-
18
-
val debugf : ('a, out_channel, unit) format -> 'a
19
-
val infof : ('a, out_channel, unit) format -> 'a
20
-
val warningf : ('a, out_channel, unit) format -> 'a
21
-
val errorf : ('a, out_channel, unit) format -> 'a
22
-
23
-
val log : level -> string -> unit
24
-
(** Simple string logging functions (for backward compatibility) *)
25
-
26
-
val debug : string -> unit
27
-
val info : string -> unit
28
-
val warning : string -> unit
29
-
val error : string -> unit
30
-
end
31
-
32
9
(** Context for tools and resources *)
33
10
module Context : sig
34
11
type t
+93
-70
lib/mcp_server.ml
+93
-70
lib/mcp_server.ml
···
2
2
open Jsonrpc
3
3
open Mcp_sdk
4
4
5
+
let src = Logs.Src.create "mcp.sdk" ~doc:"mcp.sdk logging"
6
+
7
+
module Log = (val Logs.src_log src : Logs.LOG)
8
+
5
9
(* Create a proper JSONRPC error with code and data *)
6
10
let create_jsonrpc_error id code message ?data () =
7
11
let error_code = ErrorCode.to_int code in
···
10
14
11
15
(* Process initialize request *)
12
16
let handle_initialize server req =
13
-
Log.debug "Processing initialize request";
17
+
Log.debug (fun m -> m "Processing initialize request");
14
18
let result =
15
19
match req.JSONRPCMessage.params with
16
20
| Some params ->
17
21
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);
25
+
Log.debug (fun m ->
26
+
m "Client protocol version: %s" req_data.protocol_version);
21
27
22
28
(* Create initialize response *)
23
29
let result =
···
31
37
in
32
38
Initialize.Result.yojson_of_t result
33
39
| None ->
34
-
Log.error "Missing params for initialize request";
40
+
Log.err (fun m -> m "Missing params for initialize request");
35
41
`Assoc [ ("error", `String "Missing params for initialize request") ]
36
42
in
37
43
Some (create_response ~id:req.id ~result)
38
44
39
45
(* Process tools/list request *)
40
46
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");
42
48
let tools_list = Tool.to_rpc_tools_list (tools server) in
43
49
let response =
44
50
Mcp_rpc.ToolsList.create_response ~id:req.id ~tools:tools_list ()
···
47
53
48
54
(* Process prompts/list request *)
49
55
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");
51
57
let prompts_list = Prompt.to_rpc_prompts_list (prompts server) in
52
58
let response =
53
59
Mcp_rpc.PromptsList.create_response ~id:req.id ~prompts:prompts_list ()
···
56
62
57
63
(* Process resources/list request *)
58
64
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");
60
66
let resources_list = Resource.to_rpc_resources_list (resources server) in
61
67
let response =
62
68
Mcp_rpc.ResourcesList.create_response ~id:req.id ~resources:resources_list
···
66
72
67
73
(* Process resources/templates/list request *)
68
74
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");
70
76
let templates_list =
71
77
ResourceTemplate.to_rpc_resource_templates_list (resource_templates server)
72
78
in
···
144
150
145
151
(* Process resources/read request *)
146
152
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");
148
154
match req.JSONRPCMessage.params with
149
155
| None ->
150
-
Log.error "Missing params for resources/read request";
156
+
Log.err (fun m -> m "Missing params for resources/read request");
151
157
Some
152
158
(create_jsonrpc_error req.id ErrorCode.InvalidParams
153
159
"Missing params for resources/read request" ())
154
160
| Some params -> (
155
161
let req_data = Mcp_rpc.ResourcesRead.Request.t_of_yojson params in
156
162
let uri = req_data.uri in
157
-
Log.debugf "Resource URI: %s" uri;
163
+
Log.debug (fun m -> m "Resource URI: %s" uri);
158
164
159
165
(* Find matching resource or template *)
160
166
match Resource_matcher.find_match server uri with
···
168
174
()
169
175
in
170
176
171
-
Log.debugf "Handling direct resource: %s" resource.name;
177
+
Log.debug (fun m -> m "Handling direct resource: %s" resource.name);
172
178
173
179
(* Call the resource handler *)
174
180
match resource.handler ctx params with
···
195
201
in
196
202
Some response
197
203
| Error err ->
198
-
Log.errorf "Error reading resource: %s" err;
204
+
Log.err (fun m -> m "Error reading resource: %s" err);
199
205
Some
200
206
(create_jsonrpc_error req.id ErrorCode.InternalError
201
207
("Error reading resource: " ^ err)
···
210
216
()
211
217
in
212
218
213
-
Log.debugf "Handling resource template: %s with params: [%s]"
214
-
template.name
215
-
(String.concat ", " params);
219
+
Log.debug (fun m ->
220
+
m "Handling resource template: %s with params: [%s]" template.name
221
+
(String.concat ", " params));
216
222
217
223
(* Call the template handler *)
218
224
match template.handler ctx params with
···
239
245
in
240
246
Some response
241
247
| Error err ->
242
-
Log.errorf "Error reading resource template: %s" err;
248
+
Log.err (fun m -> m "Error reading resource template: %s" err);
243
249
Some
244
250
(create_jsonrpc_error req.id ErrorCode.InternalError
245
251
("Error reading resource template: " ^ err)
246
252
()))
247
253
| Resource_matcher.NoMatch ->
248
-
Log.errorf "Resource not found: %s" uri;
254
+
Log.err (fun m -> m "Resource not found: %s" uri);
249
255
Some
250
256
(create_jsonrpc_error req.id ErrorCode.InvalidParams
251
257
("Resource not found: " ^ uri)
···
255
261
let extract_tool_name params =
256
262
match List.assoc_opt "name" params with
257
263
| Some (`String name) ->
258
-
Log.debugf "Tool name: %s" name;
264
+
Log.debug (fun m -> m "Tool name: %s" name);
259
265
Some name
260
266
| _ ->
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");
262
268
None
263
269
264
270
(* Extract the tool arguments from params *)
265
271
let extract_tool_arguments params =
266
272
match List.assoc_opt "arguments" params with
267
273
| Some args ->
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));
269
275
args
270
276
| _ ->
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");
272
279
`Assoc [] (* Empty arguments is valid *)
273
280
274
281
(* Execute a tool *)
275
282
let execute_tool server ctx name args =
276
283
try
277
284
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);
279
286
280
287
(* Call the tool handler *)
281
288
match tool.handler ctx args with
282
289
| Ok result ->
283
-
Log.debug "Tool execution succeeded";
290
+
Log.debug (fun m -> m "Tool execution succeeded");
284
291
result
285
292
| Error err -> Tool.handle_execution_error err
286
293
with
···
311
318
312
319
(* Process tools/call request *)
313
320
let handle_tools_call server req =
314
-
Log.debug "Processing tools/call request";
321
+
Log.debug (fun m -> m "Processing tools/call request");
315
322
match req.JSONRPCMessage.params with
316
323
| Some (`Assoc params) -> (
317
324
match extract_tool_name params with
···
343
350
(create_jsonrpc_error req.id InvalidParams
344
351
"Missing tool name parameter" ()))
345
352
| _ ->
346
-
Log.error "Invalid params format for tools/call";
353
+
Log.err (fun m -> m "Invalid params format for tools/call");
347
354
Some
348
355
(create_jsonrpc_error req.id InvalidParams
349
356
"Invalid params format for tools/call" ())
350
357
351
358
(* Process ping request *)
352
359
let handle_ping (req : JSONRPCMessage.request) =
353
-
Log.debug "Processing ping request";
360
+
Log.debug (fun m -> m "Processing ping request");
354
361
Some (create_response ~id:req.JSONRPCMessage.id ~result:(`Assoc []))
355
362
356
363
(* Handle notifications/initialized *)
357
364
let handle_initialized (notif : JSONRPCMessage.notification) =
358
-
Log.debug
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
363
-
| None -> "null");
365
+
Log.debug (fun m ->
366
+
m
367
+
"Client initialization complete - Server is now ready to receive \
368
+
requests\n\
369
+
\ Notification params: %s"
370
+
(match notif.JSONRPCMessage.params with
371
+
| Some p -> Yojson.Safe.to_string p
372
+
| None -> "null"));
364
373
None
365
374
366
375
(* Process a single message using the MCP SDK *)
367
376
let process_message server message =
368
377
try
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));
370
380
match JSONRPCMessage.t_of_yojson message with
371
381
| 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));
374
384
match req.meth with
375
385
| Method.Initialize -> handle_initialize server req
376
386
| Method.ToolsList -> handle_tools_list server req
···
381
391
| Method.ResourceTemplatesList ->
382
392
handle_resource_templates_list server req
383
393
| _ ->
384
-
Log.errorf "Unknown method received: %s" (Method.to_string req.meth);
394
+
Log.err (fun m ->
395
+
m "Unknown method received: %s" (Method.to_string req.meth));
385
396
Some
386
397
(create_jsonrpc_error req.id ErrorCode.MethodNotFound
387
398
("Method not found: " ^ Method.to_string req.meth)
388
399
()))
389
400
| 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));
392
404
match notif.meth with
393
405
| Method.Initialized -> handle_initialized notif
394
406
| _ ->
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));
396
409
None)
397
410
| JSONRPCMessage.Response _ ->
398
-
Log.error "Unexpected response message received";
411
+
Log.err (fun m -> m "Unexpected response message received");
399
412
None
400
413
| JSONRPCMessage.Error _ ->
401
-
Log.error "Unexpected error message received";
414
+
Log.err (fun m -> m "Unexpected error message received");
402
415
None
403
416
with
404
417
| Json.Of_json (msg, _) ->
405
-
Log.errorf "JSON error: %s" msg;
418
+
Log.err (fun m -> m "JSON error: %s" msg);
406
419
(* Can't respond with error because we don't have a request ID *)
407
420
None
408
421
| Yojson.Json_error msg ->
409
-
Log.errorf "JSON parse error: %s" msg;
422
+
Log.err (fun m -> m "JSON parse error: %s" msg);
410
423
(* Can't respond with error because we don't have a request ID *)
411
424
None
412
425
| exc ->
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);
426
+
Log.err (fun m ->
427
+
m
428
+
"Exception during message processing: %s\n\
429
+
Backtrace: %s\n\
430
+
Message was: %s"
431
+
(Printexc.to_string exc)
432
+
(Printexc.get_backtrace ())
433
+
(Yojson.Safe.to_string message));
417
434
None
418
435
419
436
(* Extract a request ID from a potentially malformed message *)
···
431
448
(* Handle processing for an input line *)
432
449
let process_input_line server line =
433
450
if line = "" then (
434
-
Log.debug "Empty line received, ignoring";
451
+
Log.debug (fun m -> m "Empty line received, ignoring");
435
452
None)
436
453
else (
437
-
Log.debugf "Raw input: %s" line;
454
+
Log.debug (fun m -> m "Raw input: %s" line);
438
455
try
439
456
let json = Yojson.Safe.from_string line in
440
-
Log.debug "Successfully parsed JSON";
457
+
Log.debug (fun m -> m "Successfully parsed JSON");
441
458
442
459
(* Process the message *)
443
460
process_message server json
444
461
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);
447
464
None)
448
465
449
466
(* Send a response to the client *)
450
467
let send_response stdout response =
451
468
let response_json = JSONRPCMessage.yojson_of_t response in
452
469
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);
454
471
455
472
(* Write the response followed by a newline *)
456
473
Eio.Flow.copy_string response_str stdout;
···
460
477
let callback mcp_server _conn (request : Http.Request.t) body =
461
478
match request.meth with
462
479
| `POST -> (
463
-
Log.debug "Received POST request";
480
+
Log.debug (fun m -> m "Received POST request");
464
481
let request_body_str =
465
482
Eio.Buf_read.(parse_exn take_all) body ~max_size:max_int
466
483
in
···
468
485
| Some mcp_response ->
469
486
let response_json = JSONRPCMessage.yojson_of_t mcp_response in
470
487
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);
472
489
let headers =
473
490
Http.Header.of_list [ ("Content-Type", "application/json") ]
474
491
in
···
476
493
~body:(Cohttp_eio.Body.of_string response_str)
477
494
()
478
495
| None ->
479
-
Log.debug "No MCP response needed";
496
+
Log.debug (fun m -> m "No MCP response needed");
480
497
Cohttp_eio.Server.respond ~status:`No_content
481
498
~body:(Cohttp_eio.Body.of_string "")
482
499
())
483
500
| _ ->
484
-
Log.infof "Unsupported method: %s" (Http.Method.to_string request.meth);
501
+
Log.info (fun m ->
502
+
m "Unsupported method: %s" (Http.Method.to_string request.meth));
485
503
Cohttp_eio.Server.respond ~status:`Method_not_allowed
486
504
~body:(Cohttp_eio.Body.of_string "Only POST is supported")
487
505
()
···
493
511
let net = Eio.Stdenv.net env in
494
512
let addr = `Tcp (Eio.Net.Ipaddr.V4.loopback, port) in
495
513
496
-
Log.debugf "Starting MCP server: %s v%s" (name server) (version server);
497
-
Log.debugf "Protocol version: %s" (protocol_version server);
514
+
Log.info (fun m ->
515
+
m "Starting http MCP server: %s v%s\nProtocol version: %s" (name server)
516
+
(version server) (protocol_version server));
498
517
499
518
Eio.Switch.run @@ fun sw ->
500
519
let server_spec = Cohttp_eio.Server.make ~callback:(callback server) () in
···
502
521
let server_socket =
503
522
Eio.Net.listen net ~sw ~backlog:128 ~reuse_addr:true addr
504
523
in
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);
506
525
507
526
Cohttp_eio.Server.run server_socket server_spec ~on_error
508
527
509
528
(** run the server using the stdio transport *)
510
-
let run_sdtio_server env server =
529
+
let run_stdio_server env server =
511
530
let stdin = Eio.Stdenv.stdin env in
512
531
let stdout = Eio.Stdenv.stdout env in
513
532
514
-
Log.debugf "Starting MCP server: %s v%s" (name server) (version server);
515
-
Log.debugf "Protocol version: %s" (protocol_version server);
533
+
Log.info (fun m ->
534
+
m "Starting stdio MCP server: %s v%s\nProtocol version: %s" (name server)
535
+
(version server) (protocol_version server));
516
536
517
537
(* Enable exception backtraces *)
518
538
Printexc.record_backtrace true;
···
522
542
(* Main processing loop *)
523
543
try
524
544
while true do
525
-
Log.debug "Waiting for message...";
545
+
Log.info (fun m -> m "Waiting for message...");
526
546
let line = Eio.Buf_read.line buf in
527
547
528
548
(* Process the input and send response if needed *)
529
549
match process_input_line server line with
530
550
| 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")
532
552
done
533
553
with
534
554
| End_of_file ->
535
-
Log.debug "End of file received on stdin";
555
+
Log.debug (fun m -> m "End of file received on stdin");
536
556
()
537
557
| Eio.Exn.Io _ as exn ->
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", "")` *)
559
+
Log.warn (fun m ->
560
+
m "I/O error while reading: %s" (Printexc.to_string exn));
539
561
()
540
562
| exn ->
541
-
Log.errorf "Exception while reading: %s" (Printexc.to_string exn);
563
+
Log.err (fun m ->
564
+
m "Exception while reading: %s" (Printexc.to_string exn));
542
565
()