server: email logs to user, and option to delete old ones

1 files changed, 8 insertions, 1 deletions

diff --git a/Role/User.hs b/Role/User.hs
index e999b1c..90d19de 100644
--- a/Role/User.hs
+++ b/Role/User.hs
@@ -21,6 +21,7 @@ import Control.Concurrent.STM
 import Control.Concurrent.STM.TMChan
 import System.Process
 import System.Exit
+import qualified Data.Text.IO as T
 import qualified Data.ByteString as B
 import Data.List.NonEmpty (NonEmpty(..), toList)
 import Data.Monoid
@@ -33,11 +34,17 @@ run :: UserOpts -> IO ExitCode
 run os = fromMaybe (ExitFailure 101) <$> connect
   where
 	connect = do
+		putStrLn "A debug-me session lets someone else run commands on your computer"
+		putStrLn "to debug your problem. A log of this session can be emailed to you"
+		putStrLn "at the end, which you can use to prove what they did in this session."
+		putStr "Enter your email address: "
+		hFlush stdout
+		email <- T.getLine
 		(controlinput, controloutput) <- openControlWindow
 		putStr "Connecting to debug-me server..."
 		hFlush stdout
 		usv <- newEmptyTMVarIO
-		runClientApp $ clientApp (InitMode mempty) User developerMessages $ \ochan ichan sid -> do
+		runClientApp $ clientApp (InitMode email) User developerMessages $ \ochan ichan sid -> do
 			let url = sessionIDUrl sid "localhost" 8081
 			putStrLn ""
 			putStrLn "Others can connect to this session and help you debug by running:"