diff --git a/CHANGES.md b/CHANGES.md index 6778c46c4..ffb705152 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -2,6 +2,9 @@ ## Features +- Support connecting over pipes and socket. Pipes on Windows aren't yet + supported (#946) + - Semantic highlighting support is enabled by default (#933) - Re-enable `ocamlformat-rpc` for formatting code snippets (but not files) (#920, #939) diff --git a/lsp/src/cli.ml b/lsp/src/cli.ml new file mode 100644 index 000000000..b4d8da906 --- /dev/null +++ b/lsp/src/cli.ml @@ -0,0 +1,38 @@ +module Channel = struct + type t = + | Stdio + | Pipe of string + | Socket of int +end + +module Arg = struct + type t = + { mutable pipe : string option + ; mutable port : int option + ; mutable stdio : bool + ; mutable spec : (string * Arg.spec * string) list + } + + let create () = + let t = { pipe = None; port = None; stdio = false; spec = [] } in + let spec = + [ ("--pipe", Arg.String (fun p -> t.pipe <- Some p), "set pipe path") + ; ("--socket", Arg.Int (fun p -> t.port <- Some p), "set port") + ; ("--stdio", Arg.Unit (fun () -> t.stdio <- true), "set stdio") + ; ( "--node-ipc" + , Arg.Unit (fun () -> raise @@ Arg.Bad "node-ipc isn't supported") + , "not supported" ) + ] + in + t.spec <- spec; + t + + let spec t = t.spec + + let read { pipe; port; stdio; spec = _ } : (Channel.t, string) result = + match (pipe, port, stdio) with + | None, None, _ -> Ok Stdio + | Some p, None, false -> Ok (Pipe p) + | None, Some s, false -> Ok (Socket s) + | _, _, _ -> Error "invalid arguments" +end diff --git a/lsp/src/cli.mli b/lsp/src/cli.mli new file mode 100644 index 000000000..80eb56f83 --- /dev/null +++ b/lsp/src/cli.mli @@ -0,0 +1,16 @@ +module Channel : sig + type t = + | Stdio + | Pipe of string + | Socket of int +end + +module Arg : sig + type t + + val create : unit -> t + + val spec : t -> (string * Arg.spec * string) list + + val read : t -> (Channel.t, string) result +end diff --git a/lsp/src/lsp.ml b/lsp/src/lsp.ml index 48c828776..be290601e 100644 --- a/lsp/src/lsp.ml +++ b/lsp/src/lsp.ml @@ -10,3 +10,4 @@ module Text_document = Text_document module Types = Types module Uri = Uri0 module Io = Io +module Cli = Cli diff --git a/ocaml-lsp-server/bin/dune b/ocaml-lsp-server/bin/dune index 16d0f5178..518ed8e58 100644 --- a/ocaml-lsp-server/bin/dune +++ b/ocaml-lsp-server/bin/dune @@ -2,4 +2,4 @@ (name main) (package ocaml-lsp-server) (public_name ocamllsp) - (libraries dune-build-info stdune ocaml_lsp_server)) + (libraries dune-build-info stdune lsp ocaml_lsp_server)) diff --git a/ocaml-lsp-server/bin/main.ml b/ocaml-lsp-server/bin/main.ml index 141490296..d0cbf3777 100644 --- a/ocaml-lsp-server/bin/main.ml +++ b/ocaml-lsp-server/bin/main.ml @@ -1,16 +1,35 @@ +open Stdune +module Cli = Lsp.Cli + let () = Printexc.record_backtrace true; let version = ref false in let read_dot_merlin = ref false in - Arg.parse + let arg = Lsp.Cli.Arg.create () in + let spec = [ ("--version", Arg.Set version, "print version") ; ( "--fallback-read-dot-merlin" , Arg.Set read_dot_merlin , "read Merlin config from .merlin files. The `dot-merlin-reader` \ package must be installed" ) ] - (fun _ -> raise (Arg.Bad "anonymous arguments are not accepted")) - "ocamllsp"; + @ Cli.Arg.spec arg + in + let usage = + "ocamllsp [ --stdio | --socket SOCKET --port PORT | --pipe PIPE ]" + in + Arg.parse + spec + (fun _ -> raise @@ Arg.Bad "anonymous arguments aren't allowed") + usage; + let channel = + match Cli.Arg.read arg with + | Ok c -> c + | Error s -> + Format.eprintf "%s@.%!" s; + Arg.usage spec usage; + exit 1 + in let version = !version in if version then let version = Ocaml_lsp_server.Version.get () in @@ -19,7 +38,7 @@ let () = let module Exn_with_backtrace = Stdune.Exn_with_backtrace in match Exn_with_backtrace.try_with - (Ocaml_lsp_server.run ~read_dot_merlin:!read_dot_merlin) + (Ocaml_lsp_server.run channel ~read_dot_merlin:!read_dot_merlin) with | Ok () -> () | Error exn -> diff --git a/ocaml-lsp-server/src/ocaml_lsp_server.ml b/ocaml-lsp-server/src/ocaml_lsp_server.ml index 21ce1b868..531061742 100644 --- a/ocaml-lsp-server/src/ocaml_lsp_server.ml +++ b/ocaml-lsp-server/src/ocaml_lsp_server.ml @@ -1010,7 +1010,7 @@ let on_notification server (notification : Client_notification.t) : in state -let start () = +let start stream = let detached = Fiber.Pool.create () in let server = Fdecl.create Dyn.opaque in let store = Document_store.make server detached in @@ -1018,11 +1018,6 @@ let start () = let on_request = { Server.Handler.on_request } in Server.Handler.make ~on_request ~on_notification () in - let* stream = - let* stdin = Lev_fiber.Io.stdin in - let+ stdout = Lev_fiber.Io.stdout in - Lsp_fiber.Fiber_io.make stdin stdout - in let ocamlformat_rpc = Ocamlformat_rpc.create () in let* configuration = Configuration.default () in let wheel = Configuration.wheel configuration in @@ -1105,8 +1100,37 @@ let start () = let metrics = Metrics.create () in Metrics.with_metrics metrics run -let run ~read_dot_merlin () = +let socket sockaddr = + let domain = Unix.domain_of_sockaddr sockaddr in + let fd = + Lev_fiber.Fd.create + (Unix.socket ~cloexec:true domain Unix.SOCK_STREAM 0) + (`Non_blocking false) + in + let* () = Lev_fiber.Socket.connect fd sockaddr in + Lev_fiber.Io.create_rw fd + +let stream_of_channel : Lsp.Cli.Channel.t -> _ = function + | Stdio -> + let* stdin = Lev_fiber.Io.stdin in + let+ stdout = Lev_fiber.Io.stdout in + (stdin, stdout) + | Pipe path -> + if Sys.win32 then ( + Format.eprintf "windows pipes are not supported"; + exit 1) + else + let sockaddr = Unix.ADDR_UNIX path in + socket sockaddr + | Socket port -> + let sockaddr = Unix.ADDR_INET (Unix.inet_addr_loopback, port) in + socket sockaddr + +let run channel ~read_dot_merlin () = Merlin_utils.Lib_config.set_program_name "ocamllsp"; Merlin_config.should_read_dot_merlin := read_dot_merlin; Unix.putenv "__MERLIN_MASTER_PID" (string_of_int (Unix.getpid ())); - Lev_fiber.run ~sigpipe:`Ignore start |> Lev_fiber.Error.ok_exn + Lev_fiber.run ~sigpipe:`Ignore (fun () -> + let* input, output = stream_of_channel channel in + start (Lsp_fiber.Fiber_io.make input output)) + |> Lev_fiber.Error.ok_exn diff --git a/ocaml-lsp-server/src/ocaml_lsp_server.mli b/ocaml-lsp-server/src/ocaml_lsp_server.mli index 17e6f16ab..6a20eb767 100644 --- a/ocaml-lsp-server/src/ocaml_lsp_server.mli +++ b/ocaml-lsp-server/src/ocaml_lsp_server.mli @@ -1,4 +1,4 @@ -val run : read_dot_merlin:bool -> unit -> unit +val run : Lsp.Cli.Channel.t -> read_dot_merlin:bool -> unit -> unit module Diagnostics = Diagnostics module Version = Version