/quit

This commit was sponsored by Jake Vosloo on Patreon.

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.