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. --- ControlSocket.hs | 1 + ControlWindow.hs | 42 ++++++++++++++++++++++++------------------ Role/Developer.hs | 1 + Role/User.hs | 11 +++++++---- debug-me.1 | 5 ++--- doc/index.mdwn | 9 --------- 6 files changed, 35 insertions(+), 34 deletions(-) diff --git a/ControlSocket.hs b/ControlSocket.hs index 2cf7d86..a53a2e7 100644 --- a/ControlSocket.hs +++ b/ControlSocket.hs @@ -32,6 +32,7 @@ data ControlInput data ControlOutput = ControlOutputAction ControlAction | ControlWindowOpened + | ControlWindowRequestedImmediateQuit deriving (Show, Generic) instance ToJSON ControlInput diff --git a/ControlWindow.hs b/ControlWindow.hs index 3f050aa..e561017 100644 --- a/ControlWindow.hs +++ b/ControlWindow.hs @@ -25,8 +25,7 @@ import Control.Concurrent.Async import Control.Concurrent.STM import Control.Concurrent.STM.TMChan import qualified Data.ByteString as B -import qualified Data.ByteString.Lazy as L -import Data.ByteString.UTF8 (fromString, toString) +import Data.ByteString.UTF8 (fromString) import Data.Char import Control.Monad import Data.Monoid @@ -42,6 +41,7 @@ displayInControlWindow ichan msg = atomically $ controlWindow :: ControlOpts -> IO () controlWindow _ = do putStrLn $ "** " ++ winDesc + putStrLn "(Enter /quit here at any time to end the debug-me session.)" socketfile <- defaultSocketFile ichan <- newTMChanIO ochan <- newTMChanIO @@ -80,7 +80,7 @@ openControlWindow = do return (ichan, ochan) type Prompt = () -type Response = B.ByteString +type Response = String type PromptChan = TChan Prompt type ResponseChan = TChan Response @@ -88,21 +88,27 @@ type ResponseChan = TChan Response collectOutput :: TMChan ControlOutput -> PromptChan -> ResponseChan -> IO () collectOutput ochan promptchan responsechan = do myusername <- fromString <$> getLoginName - withLines stdin $ mapM_ $ processline myusername + loop myusername where - processline myusername l = do - mc <- atomically $ do - -- Is any particular input being prompted for now? - mp <- tryReadTChan promptchan - case mp of - Just _ -> do - writeTChan responsechan $ L.toStrict l - return Nothing - Nothing -> do - let c = ChatMessage (Val myusername) (Val $ L.toStrict l) - writeTMChan ochan $ ControlOutputAction c - return (Just c) - maybe (return ()) displayChatMessage mc + loop myusername = do + l <- getLine + if map toLower l == "/quit" + then atomically $ + writeTMChan ochan ControlWindowRequestedImmediateQuit + else do + mc <- atomically $ do + -- Is any particular input being prompted for now? + mp <- tryReadTChan promptchan + case mp of + Just _ -> do + writeTChan responsechan l + return Nothing + Nothing -> do + let c = ChatMessage (Val myusername) (Val $ fromString l) + writeTMChan ochan $ ControlOutputAction c + return (Just c) + maybe (return ()) displayChatMessage mc + loop myusername displayInput :: TMChan ControlOutput -> TMChan ControlInput -> PromptChan -> ResponseChan -> IO () displayInput ochan ichan promptchan responsechan = loop @@ -150,7 +156,7 @@ askToAllow ochan promptchan responsechan k@(GpgSigned pk _) = do putStr "Let them connect to the debug-me session and run commands? [y/n] " hFlush stdout r <- atomically $ readTChan responsechan - case map toLower (toString r) of + case map toLower r of "y" -> accept "yes" -> accept "n" -> reject 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 () diff --git a/debug-me.1 b/debug-me.1 index 1bdd5fc..8b39974 100644 --- a/debug-me.1 +++ b/debug-me.1 @@ -28,9 +28,8 @@ running their buggy program in different ways, perhaps running a debugger, or looking at configuration files. They should *not* be looking at your personal files without asking you first in the debug-me chat window. They should not be downloading or installing other software. If you see -them do anything you don't expect, press Control-S immediately, which -will prevent them from doing anything else. You can also press -Control-Backslash to immediately end the debug-me session. +them do anything you don't expect, you can enter "/quit" in the control +window to immediately end the debug-me session. .PP If the developer did do something bad, you'd have proof that they cannot be trusted, which you can share with the world. Knowing that is the case diff --git a/doc/index.mdwn b/doc/index.mdwn index 7dafc20..f594425 100644 --- a/doc/index.mdwn +++ b/doc/index.mdwn @@ -28,15 +28,6 @@ to let them type into your console in a debug-me session. Once the session is done, the debug-me server will email you the signed evidence of what the developer did in the session. -It's a good idea to watch the debug-me session. The developer should be -running their buggy program in different ways, perhaps running a debugger, -or looking at configuration files. They should *not* be looking at your -personal files without asking you first in the debug-me chat window. -They should not be downloading or installing other software. If you see -them do anything you don't expect, press Control-S immediately, which -will prevent them from doing anything else. You can also press -Control-Backslash to immediately end the debug-me session. - If the developer did do something bad, you'd have proof that they cannot be trusted, which you can share with the world. Knowing that is the case will keep most developers honest. -- cgit v1.2.3