From 0f9bb68ba29dc890a4131efddc907cedddc56a40 Mon Sep 17 00:00:00 2001
From: giles <giles.bradshaw@rose-ash.com>
Date: Fri, 17 Apr 2026 08:26:54 +0000
Subject: [PATCH] MCP tree server: add failure logging to /tmp/mcp-tree.log

Logs timestamps, tool calls, errors, slow calls, stack overflow, OOM.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
---
 hosts/ocaml/bin/mcp_tree.ml | 72 +++++++++++++++++++++++++++++++++----
 1 file changed, 65 insertions(+), 7 deletions(-)

diff --git a/hosts/ocaml/bin/mcp_tree.ml b/hosts/ocaml/bin/mcp_tree.ml
index 53b96a72..0d269a00 100644
--- a/hosts/ocaml/bin/mcp_tree.ml
+++ b/hosts/ocaml/bin/mcp_tree.ml
@@ -10,6 +10,25 @@ open Sx_types
 (* Hot-reload: re-exec ourselves when the binary has been rebuilt       *)
 (* ------------------------------------------------------------------ *)
 
+(* ------------------------------------------------------------------ *)
+(* File-based logging for debugging MCP failures                       *)
+(* ------------------------------------------------------------------ *)
+
+let log_file = "/tmp/mcp-tree.log"
+
+let log_msg fmt =
+  Printf.ksprintf (fun msg ->
+    let oc = open_out_gen [Open_append; Open_creat; Open_wronly] 0o644 log_file in
+    let t = Unix.gettimeofday () in
+    let tm = Unix.localtime t in
+    Printf.fprintf oc "[%04d-%02d-%02d %02d:%02d:%02d.%03d] %s\n"
+      (1900 + tm.Unix.tm_year) (tm.Unix.tm_mon + 1) tm.Unix.tm_mday
+      tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec
+      (int_of_float (mod_float (t *. 1000.0) 1000.0))
+      msg;
+    close_out oc
+  ) fmt
+
 let exe_path =
   try Unix.readlink "/proc/self/exe"
   with _ -> Sys.executable_name
@@ -2577,10 +2596,28 @@ let handle_sx_request args =
 let handle_tool name args =
   match Hashtbl.find_opt tool_handlers name with
   | Some handler ->
-    (try handler args
-     with Invalid_argument msg -> error_result msg
-        | e -> error_result ("Error: " ^ Printexc.to_string e))
-  | None -> error_result ("Unknown tool: " ^ name)
+    (try
+      let file_arg = try Yojson.Safe.Util.(args |> member "file" |> to_string) with _ -> "" in
+      let t0 = Unix.gettimeofday () in
+      let r = handler args in
+      let elapsed = (Unix.gettimeofday () -. t0) *. 1000.0 in
+      log_msg "OK [%s] %s (%.0fms)" name (if file_arg <> "" then "file=" ^ file_arg else "") elapsed;
+      r
+     with Invalid_argument msg ->
+        log_msg "INVALID_ARG [%s]: %s" name msg;
+        error_result msg
+        | Stack_overflow ->
+        log_msg "STACK OVERFLOW [%s]" name;
+        error_result "Stack overflow — file too large or recursive structure"
+        | Out_of_memory ->
+        log_msg "OUT OF MEMORY [%s]" name;
+        error_result "Out of memory"
+        | e ->
+        log_msg "EXCEPTION [%s]: %s" name (Printexc.to_string e);
+        error_result ("Error: " ^ Printexc.to_string e))
+  | None ->
+    log_msg "UNKNOWN TOOL: %s" name;
+    error_result ("Unknown tool: " ^ name)
 
 let () =
   register "sx_read_tree" handle_sx_read_tree;
@@ -2848,6 +2885,7 @@ let dispatch method_name params =
 
 let () =
   setup_env ();
+  log_msg "Server started (pid=%d, cwd=%s)" (Unix.getpid ()) (Sys.getcwd ());
   try while true do
     let line = input_line stdin in
     if String.length line > 0 then begin
@@ -2857,10 +2895,27 @@ let () =
         let meth = json |> member "method" |> to_string_option |> Option.value ~default:"" in
         let params = json |> member "params" in
         let id = json |> member "id" in
+        let tool_name = if meth = "tools/call" then
+          (try params |> member "name" |> to_string with _ -> "?")
+        else meth in
+        let t0 = Unix.gettimeofday () in
         let result =
           try dispatch meth params
-          with e -> error_result ("Error: " ^ Printexc.to_string e)
+          with e ->
+            let msg = Printexc.to_string e in
+            log_msg "DISPATCH ERROR [%s]: %s" tool_name msg;
+            error_result ("Error: " ^ msg)
         in
+        let elapsed = (Unix.gettimeofday () -. t0) *. 1000.0 in
+        if elapsed > 5000.0 then
+          log_msg "SLOW [%s]: %.0fms" tool_name elapsed;
+        (* Check for error in result *)
+        (match result with
+         | `Assoc items when List.mem_assoc "isError" items ->
+           log_msg "TOOL ERROR [%s]: %s (%.0fms)" tool_name
+             (try result |> member "content" |> to_list |> List.hd |> member "text" |> to_string with _ -> "?")
+             elapsed
+         | _ -> ());
         if id <> `Null then begin
           let resp = `Assoc [
             ("jsonrpc", `String "2.0");
@@ -2872,7 +2927,10 @@ let () =
           check_hot_reload ()
         end
       with e ->
-        Printf.eprintf "[mcp] Request error: %s\n%!" (Printexc.to_string e)
+        let msg = Printexc.to_string e in
+        log_msg "REQUEST PARSE ERROR: %s" msg;
+        Printf.eprintf "[mcp] Request error: %s\n%!" msg
     end
   done
-  with End_of_file -> ()
+  with End_of_file ->
+    log_msg "Server shutting down (End_of_file)"