From 4b828a123be460e68fe5fd0d17812003ca877ee8 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 2 May 2017 17:27:37 -0400 Subject: /quit This commit was sponsored by Jake Vosloo on Patreon. --- Role/User.hs | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) (limited to 'Role/User.hs') diff --git a/Role/User.hs b/Role/User.hs index a7e4843..49e9edf 100644 --- a/Role/User.hs +++ b/Role/User.hs @@ -65,8 +65,8 @@ run os = fromMaybe (ExitFailure 101) <$> connect us <- startProtocol startSession ochan logger atomically $ putTMVar usv us workers <- mapM async - [ sendControlOutput controloutput ochan us logger - , sendPtyOutput p ochan us logger + [ sendPtyOutput p ochan us logger + , sendControlOutput controloutput ochan us logger ph ] mainworker <- async $ sendPtyInput ichan ochan controlinput p us logger `race` forwardTtyInputToPty p @@ -350,8 +350,8 @@ isLegalEntered (Activity a (Just hp) lastentered _ _) us -- -- When the control window sends a SessionKeyAccepted, add it to the -- sigVerifier. -sendControlOutput :: TMChan ControlOutput -> TMChan (Message Seen) -> TVar UserState -> Logger -> IO () -sendControlOutput controloutput ochan us logger = loop +sendControlOutput :: TMChan ControlOutput -> TMChan (Message Seen) -> TVar UserState -> Logger -> ProcessHandle -> IO () +sendControlOutput controloutput ochan us logger ph = loop where loop = go =<< atomically (readTMChan controloutput) go Nothing = return () @@ -369,3 +369,6 @@ sendControlOutput controloutput ochan us logger = loop l <- atomically $ sendDeveloper ochan us c now logger (User l) loop + go (Just ControlWindowRequestedImmediateQuit) = do + terminateProcess ph + return () -- cgit v1.2.3