diff options
Diffstat (limited to 'Role')
| -rw-r--r-- | Role/Developer.hs | 1 | ||||
| -rw-r--r-- | Role/User.hs | 11 |
2 files changed, 8 insertions, 4 deletions
diff --git a/Role/Developer.hs b/Role/Developer.hs index d8d9d2c..51ada28 100644 --- a/Role/Developer.hs +++ b/Role/Developer.hs @@ -188,6 +188,7 @@ sendControlOutput controloutput ichan devstate logger = loop return msg logger (Developer msg) loop + go (Just ControlWindowRequestedImmediateQuit) = return () -- | Read activity from the TMChan and display it to the developer. -- 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 () |