From fa9dd39a5c610d53e15625d079b00680a1236b57 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 8 May 2024 11:40:56 -0400 Subject: [PATCH] add more error handlers and logging around notif/request handlers --- src/blocking_IO.ml | 9 +++- src/common_.ml | 1 + src/jsonrpc2.ml | 64 +++++++++++++++++++---------- src/lwt/linol_lwt.ml | 8 +++- src/server.ml | 98 +++++++++++++++++++++++++++++++------------- src/sigs.ml | 4 +- 6 files changed, 129 insertions(+), 55 deletions(-) diff --git a/src/blocking_IO.ml b/src/blocking_IO.ml index 1abfc836..a21b3ef3 100644 --- a/src/blocking_IO.ml +++ b/src/blocking_IO.ml @@ -9,7 +9,7 @@ let ( let* ) x f = f x let ( and+ ) a b = a, b let return x = x let failwith = failwith -let fail = raise +let fail = Printexc.raise_with_backtrace let stdin = stdin let stdout = stdout @@ -24,7 +24,12 @@ let default_spawn f = in ignore (Thread.create run ()) -let catch f g = try f () with e -> g e +let catch f g = + try f () + with e -> + let bt = Printexc.get_raw_backtrace () in + g e bt + let n_bytes_written = Atomic.make 0 let n_bytes_read = Atomic.make 0 diff --git a/src/common_.ml b/src/common_.ml index c1d0ddc9..78a5810a 100644 --- a/src/common_.ml +++ b/src/common_.ml @@ -1,3 +1,4 @@ module Trace = Trace_core let ( let@ ) = ( @@ ) +let spf = Printf.sprintf diff --git a/src/jsonrpc2.ml b/src/jsonrpc2.ml index 70fbbab0..1062e409 100644 --- a/src/jsonrpc2.ml +++ b/src/jsonrpc2.ml @@ -42,8 +42,6 @@ module Make (IO : IO) : S with module IO = IO = struct type json = J.t - let spf = Printf.sprintf - module ErrorCode = Jsonrpc.Response.Error.Code (* module Err = struct @@ -138,7 +136,7 @@ module Make (IO : IO) : S with module IO = IO = struct (fun () -> let+ x = f () in Ok x) - (fun e -> IO.return (Error e)) + (fun e bt -> IO.return (Error (e, bt))) (** Sends a server notification to the LSP client. *) let send_server_notification (self : t) (n : Lsp.Server_notification.t) : @@ -166,10 +164,15 @@ module Make (IO : IO) : S with module IO = IO = struct (** Wraps some action and, in case the [IO.t] request has failed, logs the failure to the LSP client. *) let with_error_handler (self : t) (action : unit -> unit IO.t) : unit IO.t = - IO.catch action (fun e -> + IO.catch action (fun exn bt -> + let message = + spf "LSP handler failed with %s\n%s" (Printexc.to_string exn) + (Printexc.raw_backtrace_to_string bt) + in + Log.err (fun k -> k "%s" message); let msg = Lsp.Types.LogMessageParams.create ~type_:Lsp.Types.MessageType.Error - ~message:(Printexc.to_string e) + ~message in let msg = Lsp.Server_notification.LogMessage msg @@ -191,11 +194,12 @@ module Make (IO : IO) : S with module IO = IO = struct let handle_request (self : t) (r : Jsonrpc.Request.t) : unit IO.t = let protect ~id f = - IO.catch f (fun e -> + IO.catch f (fun e bt -> let message = - spf "%s\n%s" (Printexc.to_string e) (Printexc.get_backtrace ()) + spf "%s\n%s" (Printexc.to_string e) + (Printexc.raw_backtrace_to_string bt) in - Log.err (fun k -> k "error: %s" message); + Log.err (fun k -> k "error in request handler: %s" message); let r = Jsonrpc.Response.error id (Jsonrpc.Response.Error.make @@ -215,13 +219,23 @@ module Make (IO : IO) : S with module IO = IO = struct ~notify_back:(send_server_notification self) ~server_request:(server_request self) in - let reply_json = Lsp.Client_request.yojson_of_result r reply in - let response = Jsonrpc.Response.ok id reply_json in + let response = + match reply with + | Ok reply -> + let reply_json = Lsp.Client_request.yojson_of_result r reply in + Jsonrpc.Response.ok id reply_json + | Error message -> + Jsonrpc.Response.error id + (Jsonrpc.Response.Error.make + ~code:Jsonrpc.Response.Error.Code.InternalError ~message ()) + in + send_response self response | Error e -> IO.failwith (spf "cannot decode request: %s" e)) - (fun e -> + (fun e bt -> let message = - spf "%s\n%s" (Printexc.to_string e) (Printexc.get_backtrace ()) + spf "%s\n%s" (Printexc.to_string e) + (Printexc.raw_backtrace_to_string bt) in Log.err (fun k -> k "error: %s" message); let r = @@ -273,7 +287,8 @@ module Make (IO : IO) : S with module IO = IO = struct | _ -> j (* read a full message *) - let read_msg (self : t) : (Jsonrpc.Packet.t, exn) result IO.t = + let read_msg (self : t) : + (Jsonrpc.Packet.t, exn * Printexc.raw_backtrace) result IO.t = let rec read_headers acc = let*? line = try_ @@ fun () -> IO.read_line self.ic in match String.trim line with @@ -292,8 +307,9 @@ module Make (IO : IO) : S with module IO = IO = struct with | pair -> read_headers (pair :: acc) | exception _ -> - IO.return - (Error (E (ErrorCode.ParseError, spf "invalid header: %S" line)))) + let bt = Printexc.get_raw_backtrace () in + let exn = E (ErrorCode.ParseError, spf "invalid header: %S" line) in + IO.return (Error (exn, bt))) in let*? headers = read_headers [] in Log.debug (fun k -> @@ -323,15 +339,21 @@ module Make (IO : IO) : S with module IO = IO = struct (match Jsonrpc.Packet.t_of_yojson @@ fix_null_in_params j with | m -> IO.return @@ Ok m | exception exn -> + let bt = Printexc.get_raw_backtrace () in Log.err (fun k -> - k "cannot decode json message: %s" (Printexc.to_string exn)); - IO.return (Error (E (ErrorCode.ParseError, "cannot decode json")))) + k "cannot decode json message: %s\n%s" (Printexc.to_string exn) + (Printexc.raw_backtrace_to_string bt)); + let exn = E (ErrorCode.ParseError, "cannot decode json") in + IO.return (Error (exn, bt))) | exception _ -> + let bt = Printexc.get_raw_backtrace () in IO.return - @@ Error (E (ErrorCode.ParseError, "missing content-length' header")) - ) else + @@ Error (E (ErrorCode.ParseError, "missing content-length' header"), bt) + ) else ( + let bt = Printexc.get_callstack 10 in IO.return - @@ Error (E (ErrorCode.InvalidRequest, "content-type must be 'utf-8'")) + @@ Error (E (ErrorCode.InvalidRequest, "content-type must be 'utf-8'"), bt) + ) let send_server_request (self : t) (req : 'from_server Lsp.Server_request.t) (cb : ('from_server, Jsonrpc.Response.Error.t) result -> unit IO.t) : @@ -369,7 +391,7 @@ module Make (IO : IO) : S with module IO = IO = struct | Ok r -> let* () = process_msg r in loop () - | Error e -> IO.fail e + | Error (e, bt) -> IO.fail e bt in loop () end diff --git a/src/lwt/linol_lwt.ml b/src/lwt/linol_lwt.ml index c8dedd5c..f95a1b4f 100644 --- a/src/lwt/linol_lwt.ml +++ b/src/lwt/linol_lwt.ml @@ -27,8 +27,12 @@ module IO_lwt : let write = Lwt_io.write_from_exactly let read = Lwt_io.read_into_exactly let read_line = Lwt_io.read_line - let catch = Lwt.catch - let fail = Lwt.fail + + let catch f g = + let bt = Printexc.get_callstack 10 in + Lwt.catch f (fun exn -> g exn bt) + + let fail e _bt = Lwt.fail e end (** Spawn function. diff --git a/src/server.ml b/src/server.ml index 8994f395..51eaac50 100644 --- a/src/server.ml +++ b/src/server.ml @@ -60,7 +60,7 @@ module Make (IO : IO) = struct server_request:send_request -> id:Req_id.t -> 'a Lsp.Client_request.t -> - 'a IO.t + ('a, string) result IO.t (** Method called to handle client requests. @param notify_back an object used to reply to the client, send progress messages, diagnostics, etc. @@ -150,6 +150,11 @@ module Make (IO : IO) = struct } (** Current state of a document. *) + let[@inline] lift_ok x = + let open IO in + let+ x = x in + Ok x + (** An easily overloadable class. Pick the methods you want to support. The user must provide at least the callbacks for document lifecycle: open, close, update. The most basic LSP server should check documents @@ -322,10 +327,24 @@ module Make (IO : IO) = struct server_request:_ -> id:Req_id.t -> r Lsp.Client_request.t -> - r IO.t = + (r, string) result IO.t = fun ~notify_back ~server_request ~id (r : _ Lsp.Client_request.t) -> Trace.with_span ~__FILE__ ~__LINE__ "linol.on-request" - @@ fun _sp : r IO.t -> + @@ fun _sp : (r, string) result IO.t -> + (* handler to catch all errors *) + let try_catch : (unit -> (r, _) result IO.t) -> (r, _) result IO.t = + fun f -> + IO.catch f (fun exn bt -> + let msg = + spf "LSP request handler failed with %s\n%s" + (Printexc.to_string exn) + (Printexc.raw_backtrace_to_string bt) + in + Log.err (fun k -> k "%s" msg); + IO.return @@ Error msg) + in + + try_catch @@ fun () -> Log.debug (fun k -> k "handle request[id=%s] " (Req_id.to_string id)); @@ -333,7 +352,7 @@ module Make (IO : IO) = struct | Lsp.Client_request.Shutdown -> Log.info (fun k -> k "shutdown"); status <- `ReceivedShutdown; - IO.return () + IO.return @@ Ok () | Lsp.Client_request.Initialize i -> Log.debug (fun k -> k "req: initialize"); let notify_back = @@ -341,22 +360,23 @@ module Make (IO : IO) = struct ~partialResultToken:None ~workDoneToken:i.workDoneToken ~notify_back ~server_request () in - self#on_req_initialize ~notify_back i + lift_ok @@ self#on_req_initialize ~notify_back i | Lsp.Client_request.TextDocumentHover { textDocument; position; workDoneToken } -> let uri = textDocument.uri in Log.debug (fun k -> k "req: hover '%s'" (DocumentUri.to_path uri)); (match Hashtbl.find_opt docs uri with - | None -> IO.return None + | None -> IO.return @@ Ok None | Some doc_st -> let notify_back = new notify_back ~workDoneToken ~partialResultToken:None ~uri ~notify_back ~server_request () in - self#on_req_hover ~notify_back ~id ~uri ~pos:position - ~workDoneToken doc_st) + lift_ok + @@ self#on_req_hover ~notify_back ~id ~uri ~pos:position + ~workDoneToken doc_st) | Lsp.Client_request.TextDocumentCompletion { textDocument; @@ -369,15 +389,16 @@ module Make (IO : IO) = struct Log.debug (fun k -> k "req: complete '%s'" (DocumentUri.to_path uri)); (match Hashtbl.find_opt docs uri with - | None -> IO.return None + | None -> IO.return @@ Ok None | Some doc_st -> let notify_back = new notify_back ~partialResultToken ~workDoneToken ~uri ~notify_back ~server_request () in - self#on_req_completion ~notify_back ~id ~uri ~workDoneToken - ~partialResultToken ~pos:position ~ctx:context doc_st) + lift_ok + @@ self#on_req_completion ~notify_back ~id ~uri ~workDoneToken + ~partialResultToken ~pos:position ~ctx:context doc_st) | Lsp.Client_request.TextDocumentDefinition { textDocument; position; workDoneToken; partialResultToken } -> let uri = textDocument.uri in @@ -390,10 +411,11 @@ module Make (IO : IO) = struct in (match Hashtbl.find_opt docs uri with - | None -> IO.return None + | None -> IO.return @@ Ok None | Some doc_st -> - self#on_req_definition ~notify_back ~id ~workDoneToken - ~partialResultToken ~uri ~pos:position doc_st) + lift_ok + @@ self#on_req_definition ~notify_back ~id ~workDoneToken + ~partialResultToken ~uri ~pos:position doc_st) | Lsp.Client_request.TextDocumentCodeLens { textDocument; workDoneToken; partialResultToken } -> let uri = textDocument.uri in @@ -406,10 +428,11 @@ module Make (IO : IO) = struct in (match Hashtbl.find_opt docs uri with - | None -> IO.return [] + | None -> IO.return @@ Ok [] | Some doc_st -> - self#on_req_code_lens ~notify_back ~id ~uri ~workDoneToken - ~partialResultToken doc_st) + lift_ok + @@ self#on_req_code_lens ~notify_back ~id ~uri ~workDoneToken + ~partialResultToken doc_st) | Lsp.Client_request.TextDocumentCodeLensResolve cl -> Log.debug (fun k -> k "req: codelens resolve"); let notify_back = @@ -417,7 +440,7 @@ module Make (IO : IO) = struct ~workDoneToken:None ~partialResultToken:None ~notify_back ~server_request () in - self#on_req_code_lens_resolve ~notify_back ~id cl + lift_ok @@ self#on_req_code_lens_resolve ~notify_back ~id cl | Lsp.Client_request.ExecuteCommand { command; arguments; workDoneToken } -> Log.debug (fun k -> k "req: execute command '%s'" command); @@ -426,8 +449,9 @@ module Make (IO : IO) = struct ~workDoneToken ~partialResultToken:None ~notify_back ~server_request () in - self#on_req_execute_command ~notify_back ~id ~workDoneToken command - arguments + lift_ok + @@ self#on_req_execute_command ~notify_back ~id ~workDoneToken + command arguments | Lsp.Client_request.DocumentSymbol { textDocument = d; workDoneToken; partialResultToken } -> let notify_back = @@ -435,8 +459,9 @@ module Make (IO : IO) = struct ~workDoneToken ~partialResultToken ~notify_back ~server_request () in - self#on_req_symbol ~notify_back ~id ~uri:d.uri ~workDoneToken - ~partialResultToken () + lift_ok + @@ self#on_req_symbol ~notify_back ~id ~uri:d.uri ~workDoneToken + ~partialResultToken () | Lsp.Client_request.CodeAction a -> let notify_back = new notify_back @@ -444,15 +469,16 @@ module Make (IO : IO) = struct ~partialResultToken:a.partialResultToken ~notify_back ~server_request () in - self#on_req_code_action ~notify_back ~id a + lift_ok @@ self#on_req_code_action ~notify_back ~id a | Lsp.Client_request.InlayHint p -> let notify_back : notify_back = new notify_back ~workDoneToken:p.workDoneToken ~partialResultToken:None ~notify_back ~server_request () in - self#on_req_inlay_hint ~notify_back ~id ~uri:p.textDocument.uri - ~range:p.range () + lift_ok + @@ self#on_req_inlay_hint ~notify_back ~id ~uri:p.textDocument.uri + ~range:p.range () | Lsp.Client_request.CodeActionResolve _ | Lsp.Client_request.LinkedEditingRange _ | Lsp.Client_request.TextDocumentDeclaration _ @@ -492,15 +518,16 @@ module Make (IO : IO) = struct ~workDoneToken:None ~partialResultToken:None ~notify_back ~server_request () in - self#on_request_unhandled ~notify_back ~id r + lift_ok @@ self#on_request_unhandled ~notify_back ~id r | Lsp.Client_request.UnknownRequest r -> let notify_back = new notify_back ~workDoneToken:None ~partialResultToken:None ~notify_back ~server_request () in - self#on_unknown_request ~notify_back ~server_request ~id r.meth - r.params + lift_ok + @@ self#on_unknown_request ~notify_back ~server_request ~id r.meth + r.params method virtual on_notif_doc_did_open : notify_back:notify_back -> @@ -535,6 +562,21 @@ module Make (IO : IO) = struct let@ _sp = Trace.with_span ~__FILE__ ~__LINE__ "linol.on-notification" in + + (* handler to catch all errors *) + let try_catch : (unit -> unit IO.t) -> unit IO.t = + fun f -> + IO.catch f (fun exn bt -> + let msg = + spf "LSP notification handler failed with %s\n%s" + (Printexc.to_string exn) + (Printexc.raw_backtrace_to_string bt) + in + Log.err (fun k -> k "%s" msg); + IO.return ()) + in + + try_catch @@ fun () -> let open Lsp.Types in match n with | Lsp.Client_notification.TextDocumentDidOpen diff --git a/src/sigs.ml b/src/sigs.ml index 24f03dc9..afd3222d 100644 --- a/src/sigs.ml +++ b/src/sigs.ml @@ -17,6 +17,6 @@ module type IO = sig val read_line : in_channel -> string t val write : out_channel -> bytes -> int -> int -> unit t val write_string : out_channel -> string -> unit t - val fail : exn -> unit t - val catch : (unit -> 'a t) -> (exn -> 'a t) -> 'a t + val fail : exn -> Printexc.raw_backtrace -> unit t + val catch : (unit -> 'a t) -> (exn -> Printexc.raw_backtrace -> 'a t) -> 'a t end