diff options
| -rw-r--r-- | ControlSocket.hs | 1 | ||||
| -rw-r--r-- | ControlWindow.hs | 7 | ||||
| -rw-r--r-- | Gpg.hs | 1 | ||||
| -rw-r--r-- | Role/Developer.hs | 31 | ||||
| -rw-r--r-- | Role/Watcher.hs | 13 | ||||
| -rw-r--r-- | TODO | 3 | ||||
| -rw-r--r-- | WebSockets.hs | 1 |
7 files changed, 39 insertions, 18 deletions
diff --git a/ControlSocket.hs b/ControlSocket.hs index 6512f4b..782235a 100644 --- a/ControlSocket.hs +++ b/ControlSocket.hs @@ -21,6 +21,7 @@ import Data.Char data ControlInput = ControlInputAction ControlAction + | ControlWindowMessage String deriving (Show, Generic) data ControlOutput diff --git a/ControlWindow.hs b/ControlWindow.hs index 02cffd6..edd493e 100644 --- a/ControlWindow.hs +++ b/ControlWindow.hs @@ -29,6 +29,10 @@ import Prelude winDesc :: String winDesc = "debug-me session control and chat window" +displayInControlWindow :: TMChan ControlInput -> String -> IO () +displayInControlWindow ichan msg = atomically $ + writeTMChan ichan (ControlWindowMessage msg) + controlWindow :: ControlOpts -> IO () controlWindow _ = do putStrLn $ "** " ++ winDesc @@ -92,6 +96,9 @@ displayInput ochan ichan promptchan responsechan = loop where loop = go =<< atomically (readTMChan ichan) go Nothing = return () + go (Just (ControlWindowMessage m)) = do + putStrLn m + loop go (Just (ControlInputAction (SessionKey k))) = do askToAllow ochan promptchan responsechan k loop @@ -31,7 +31,6 @@ myPublicKey (MySessionKey _ epk) (GpgSign gpgsign) = do gpgSign :: PublicKey -> IO (PerhapsSigned PublicKey) gpgSign pk = do - putStrLn "Using gpg to sign the debug-me session key." -- Write it to a temp file because gpg sometimes is unhappy -- about password prompting when stdin is not connected to -- the console. diff --git a/Role/Developer.hs b/Role/Developer.hs index ca3baea..efe476a 100644 --- a/Role/Developer.hs +++ b/Role/Developer.hs @@ -3,6 +3,7 @@ module Role.Developer ( run, run', + watchSessionReadOnly, processSessionStart, getServerMessage, Output(..), @@ -51,19 +52,45 @@ run' runner url = do developer :: TMVar (TVar DeveloperState) -> TMChan (Message Entered) -> TMChan AnyMessage -> SessionID -> IO () developer dsv ichan ochan sid = withSessionLogger sid $ \logger -> do sk <- genMySessionKey + (controlinput, controloutput) <- openControlWindow + displayInControlWindow controlinput + "Using gpg to sign the debug-me session key." spk <- myPublicKey sk (GpgSign True) + displayInControlWindow controlinput + "Connecting to user ..." (devstate, startoutput) <- processSessionStart sk ochan logger dsv emitOutput startoutput + displayInControlWindow controlinput + "Waiting for the user to grant write access ..." res <- authUser spk ichan ochan devstate logger case res of Authed -> inRawMode $ void $ do - (controlinput, controloutput) <- openControlWindow + displayInControlWindow controlinput + "Write access granted. You can now type into the user's shell." + displayInControlWindow controlinput + "(And, you can type in this window to chat with the user.)" sendTtyInput ichan devstate logger `race` sendTtyOutput ochan devstate controlinput logger `race` sendControlOutput controloutput ichan devstate logger - AuthFailed -> hPutStrLn stderr "\n** User did not grant access to their terminal." + AuthFailed -> do + displayInControlWindow controlinput + "User did not grant access to their terminal. Watching session in read-only mode." + watchSessionReadOnly ochan logger devstate SessionEnded -> hPutStrLn stderr "\n** This debug-me session has already ended." +watchSessionReadOnly :: TMChan AnyMessage -> Logger -> TVar DeveloperState -> IO () +watchSessionReadOnly ochan logger st = loop + where + loop = do + ts <- getPOSIXTime + v <- atomically $ getServerMessage ochan st ts + case v of + Nothing -> return () + Just (o, msg) -> do + _ <- logger msg + emitOutput o + loop + data DeveloperState = DeveloperState { lastSeen :: Hash -- ^ Last Seen value received from the user. diff --git a/Role/Watcher.hs b/Role/Watcher.hs index dd49621..f314b46 100644 --- a/Role/Watcher.hs +++ b/Role/Watcher.hs @@ -10,7 +10,6 @@ import Role.Developer import Control.Concurrent.STM import Control.Concurrent.STM.TMChan -import Data.Time.Clock.POSIX run :: WatchOpts -> IO () run = run' watcher . watchUrl @@ -20,14 +19,4 @@ watcher dsv _ichan ochan sid = withSessionLogger sid $ \logger -> inRawMode $ do sk <- genMySessionKey (st, startoutput) <- processSessionStart sk ochan logger dsv emitOutput startoutput - go logger st - where - go logger st = do - ts <- getPOSIXTime - v <- atomically $ getServerMessage ochan st ts - case v of - Nothing -> return () - Just (o, msg) -> do - _ <- logger msg - emitOutput o - go logger st + watchSessionReadOnly ochan logger st @@ -1,6 +1,3 @@ -* When user rejects developer, the debug-me --debug prints - "User did not grant access to their terminal." and says the session - log is done, but keeps running. * GPG WoT is checked by querying pgp.cs.uu.nl, could use wotsap if it's locally installed. However, the version of wotsap in debian only supports short, insecure keyids, so is less secure than using the server. diff --git a/WebSockets.hs b/WebSockets.hs index 00f762a..7cb140b 100644 --- a/WebSockets.hs +++ b/WebSockets.hs @@ -100,6 +100,7 @@ clientApp mode recentactivity mksent filterreceived a conn = do -- Wait for any more data from the server. -- These often die with a ConnectionClosed. void $ waitCatch sthread + cancel rthread void $ waitCatch rthread go sid (schan, rchan, _, _) = a schan rchan sid |