diff options
author | Joey Hess <joeyh@joeyh.name> | 2017-05-02 17:27:37 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2017-05-02 17:27:37 -0400 |
commit | 4b828a123be460e68fe5fd0d17812003ca877ee8 (patch) | |
tree | 9079356a742558abd485702cc8871ab940a935f8 /Role/User.hs | |
parent | 63b8a7e037563d40f240dd5ae2e3befc9ff9f5fb (diff) | |
download | debug-me-4b828a123be460e68fe5fd0d17812003ca877ee8.tar.gz |
/quit
This commit was sponsored by Jake Vosloo on Patreon.
Diffstat (limited to 'Role/User.hs')
-rw-r--r-- | Role/User.hs | 11 |
1 files changed, 7 insertions, 4 deletions
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 () |