diff --git a/Properties/launchSettings.json b/Properties/launchSettings.json index a09ae13..b14f62c 100644 --- a/Properties/launchSettings.json +++ b/Properties/launchSettings.json @@ -1,7 +1,8 @@ { "profiles": { "fvim": { - "commandName": "Project" + "commandName": "Project", + "commandLineArgs": "--daemon" }, "norc": { "commandName": "Project", diff --git a/common.fs b/common.fs index 9e22c6f..ab53c7e 100644 --- a/common.fs +++ b/common.fs @@ -119,17 +119,17 @@ let run (t: Task) = Task.Run(fun () -> t) |> ignore let runSync (t: Task) = - t.Wait() + t.ConfigureAwait(false).GetAwaiter().GetResult() let rec read (stream: System.IO.Stream) (buf: Memory) = - task { - let! n = stream.ReadAsync(buf) + async { + let! n = Async.AwaitTask((stream.ReadAsync buf).AsTask()) if n = 0 then failwith "read" if n < buf.Length then return! read stream (buf.Slice n) } let write (stream: System.IO.Stream) (buf: ReadOnlyMemory) = - stream.WriteAsync(buf) + Async.AwaitTask(stream.WriteAsync(buf).AsTask()) let inline toInt32LE (x: _[]) = int32 (x.[0]) @@ -145,7 +145,7 @@ let inline fromInt32LE (x: int32) = byte (x >>> 24) |] -let runProcess prog args stderrenc = +let newProcess prog args stderrenc = let args = args |> escapeArgs |> join let psi = ProcessStartInfo(prog, args) psi.CreateNoWindow <- true @@ -157,7 +157,10 @@ let runProcess prog args stderrenc = psi.UseShellExecute <- false psi.WindowStyle <- ProcessWindowStyle.Hidden psi.WorkingDirectory <- Environment.CurrentDirectory - Process.Start(psi) + let p = new Process() + p.StartInfo <- psi + p.EnableRaisingEvents <- true + p [] module internal helpers = diff --git a/daemon.fs b/daemon.fs index 9da4408..497eab2 100644 --- a/daemon.fs +++ b/daemon.fs @@ -14,7 +14,6 @@ open log open common open getopt open System.Security.Principal -open MessagePack open System.IO type Session = @@ -26,6 +25,7 @@ type Session = proc: Process // in case the daemon crashed and we happen to be running Windows(tm)... killHandle: IDisposable + exitHandle: IDisposable } let private sessions = hashmap [] @@ -56,18 +56,28 @@ let newSession nvim stderrenc args svrpipe = let pname = pipename (string myid) let paddr = pipeaddr pname - let proc = runProcess nvim ("--headless" :: "--listen" :: paddr :: args) stderrenc - let sub = AppDomain.CurrentDomain.ProcessExit.Subscribe(fun _ -> proc.Kill(true)) + let args = "--headless" :: "--listen" :: paddr :: args + let proc = newProcess nvim args stderrenc + let killHandle = AppDomain.CurrentDomain.ProcessExit.Subscribe(fun _ -> proc.Kill(true)) let session = { id = myid server = Some svrpipe proc = proc - killHandle = sub + killHandle = killHandle + exitHandle = proc.Exited |> Observable.subscribe(fun _ -> + // remove the session + trace "Session %d terminated" myid + sessions.[myid].exitHandle.Dispose() + sessions.Remove(myid) |> ignore + killHandle.Dispose() + proc.Dispose() + ) } sessionId <- sessionId + 1 sessions.[myid] <- session + proc.Start() |> ignore Some session @@ -79,27 +89,24 @@ let attachFirstSession svrpipe = Some ns let serveSession (session: Session) = - task { + async { let pname = pipename (string session.id) + trace "Start serving session %d at pipe %s" session.id pname use client = new NamedPipeClientStream(".", pname, IO.Pipes.PipeDirection.InOut, IO.Pipes.PipeOptions.Asynchronous, TokenImpersonationLevel.Impersonation) - + do! Async.AwaitTask(client.ConnectAsync()) let fromNvim = client.CopyToAsync(session.server.Value) let toNvim = session.server.Value.CopyToAsync(client) - let! _ = Task.WhenAny [| fromNvim; toNvim |] + let! _ = Async.AwaitTask(Task.WhenAny [| fromNvim; toNvim |]) // Something is completed, let's investigate why - if not client.IsConnected then - // the connection to neovim server is gone - session.proc.Kill(true) - // remove the session - sessions.Remove(session.id) |> ignore - else - // the connection from the remote FVim is gone + if not session.proc.HasExited then + // the NeoVim server is still up and running sessions.[session.id] <- { session with server = None } + trace "Session %d detached" session.id return () } let serve nvim stderrenc (pipe: NamedPipeServerStream) = - run <| task { + async { try let rbuf = Array.zeroCreate 8192 let rmem = rbuf.AsMemory() @@ -107,19 +114,30 @@ let serve nvim stderrenc (pipe: NamedPipeServerStream) = // [magic header FVIM] 4B // [payload len] 4B, little-endian do! read pipe rmem.[0..7] - if rbuf.[0..3] <> FVR_MAGIC then return() + if rbuf.[0..3] <> FVR_MAGIC then + trace "Incorrect handshake magic. Got: %A" rbuf.[0..3] + return() let len = rbuf.[4..7] |> toInt32LE - if len >= rbuf.Length || len <= 0 then return() + if len >= rbuf.Length || len <= 0 then + trace "Invalid payload length %d" len + return() do! read pipe rmem.[0..len-1] + + try + Text.Encoding.UTF8.GetString(rbuf,0,len) + |> Json.deserialize + |> ignore + with ex -> trace "%s" (ex.ToString()) let request: FVimRemoteVerb = (rbuf, 0, len) |> Text.Encoding.UTF8.GetString |> Json.deserialize + trace "Payload=%A" request let session = match request with | NewSession args -> newSession nvim stderrenc args pipe | AttachTo id -> attachSession id pipe - | AttachFirst -> attachFirstSession pipe + | AttachFirst _ -> attachFirstSession pipe match session with | None -> return() @@ -134,17 +152,19 @@ let daemon (pname: string option) (nvim: string) (stderrenc: Text.Encoding) = let paddr = pipeaddr pname trace "FVR server address is '%s'" paddr - while true do - runSync <| task { + Async.RunSynchronously <| async { + while true do let svrpipe = new NamedPipeServerStream(pname, PipeDirection.InOut, NamedPipeServerStream.MaxAllowedServerInstances, PipeTransmissionMode.Byte, PipeOptions.Asynchronous) - do! svrpipe.WaitForConnectionAsync() - serve nvim stderrenc svrpipe - } + do! Async.AwaitTask(svrpipe.WaitForConnectionAsync()) + trace "Incoming connection." + Async.Start <| serve nvim stderrenc svrpipe + return () + } 0 -let fvrConnect (stdin: Stream) (stdout: Stream) (verb: FVimRemoteVerb) = +let fvrConnect (stdin: Stream) (verb: FVimRemoteVerb) = let payload = verb |> Json.serialize @@ -153,3 +173,4 @@ let fvrConnect (stdin: Stream) (stdout: Stream) (verb: FVimRemoteVerb) = stdin.Write(FVR_MAGIC, 0, FVR_MAGIC.Length) stdin.Write(len, 0, len.Length) stdin.Write(payload, 0, payload.Length) + stdin.Flush() diff --git a/getopt.fs b/getopt.fs index 61d43ca..89bbf04 100644 --- a/getopt.fs +++ b/getopt.fs @@ -10,7 +10,7 @@ type NeovimRemoteEndpoint = type FVimRemoteVerb = | AttachTo of id: int | NewSession of args: string list - | AttachFirst + | AttachFirst of args: int // FSharp.Json bug // | Interactive type FVimRemoteTransport = @@ -120,7 +120,7 @@ let parseOptions (args: string[]) = else Local let verb = match fvrVerb.ToLowerInvariant() with - | "attach" | "a" -> AttachFirst + | "attach" | "a" -> AttachFirst 0 | "new" | "n" -> NewSession(argsL) | v -> AttachTo(int v) let files = diff --git a/model.fs b/model.fs index ebd9dab..79f723e 100644 --- a/model.fs +++ b/model.fs @@ -661,7 +661,7 @@ let Start (serveropts, norc, debugMultigrid) = // trigger ginit upon VimEnter if not norc then - let! _ = Async.AwaitTask(nvim.command "autocmd VimEnter * runtime! ginit.vim") + let! _ = Async.AwaitTask(nvim.command "if v:vim_did_enter | runtime! ginit.vim | else | autocmd VimEnter * runtime! ginit.vim | endif") () } |> Async.RunSynchronously diff --git a/neovim.fs b/neovim.fs index 3b69437..808a37e 100644 --- a/neovim.fs +++ b/neovim.fs @@ -58,7 +58,8 @@ type Nvim() = match serveropts with | Embedded(prog, args, enc) -> trace "Starting process. Program: %s; Arguments: %A" prog args - let proc = runProcess prog args enc + let proc = newProcess prog args enc + proc.Start() |> ignore Standalone proc | NeovimRemote(Tcp ipe, _) -> let sock = new Socket(ipe.AddressFamily, SocketType.Stream, ProtocolType.Tcp) @@ -70,13 +71,16 @@ type Nvim() = RemoteSession pipe | FVimRemote(name, Local, verb, _) -> let name = Option.defaultValue defaultDaemonName name + trace "Connecting to local fvr session '%s'" name let pipe = new System.IO.Pipes.NamedPipeClientStream(".", name, IO.Pipes.PipeDirection.InOut, IO.Pipes.PipeOptions.Asynchronous, TokenImpersonationLevel.Impersonation) pipe.Connect() - fvrConnect pipe pipe verb + trace "Connected, sending session request..." + fvrConnect pipe verb RemoteSession pipe | FVimRemote(_, Remote(prog, args), verb, _) -> - let proc = runProcess prog args Text.Encoding.UTF8 - fvrConnect proc.StandardInput.BaseStream proc.StandardOutput.BaseStream verb + let proc = newProcess prog args Text.Encoding.UTF8 + proc.Start() |> ignore + fvrConnect proc.StandardInput.BaseStream verb TunneledSession proc member this.start opts =