diff options
author | Joey Hess <joeyh@joeyh.name> | 2017-04-21 19:45:09 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2017-04-21 19:45:09 -0400 |
commit | 378770cde6fb9fd85983c05eab9eeff2e34398c2 (patch) | |
tree | 761273cdf6cc507db3fb1f6d7a2658d1fd799214 /Role | |
parent | a5f677919c2db47149e545165c9cacbf2c6b07b4 (diff) | |
download | debug-me-378770cde6fb9fd85983c05eab9eeff2e34398c2.tar.gz |
working toward getting developer mode connection to server working
Diffstat (limited to 'Role')
-rw-r--r-- | Role/Developer.hs | 6 | ||||
-rw-r--r-- | Role/User.hs | 21 |
2 files changed, 19 insertions, 8 deletions
diff --git a/Role/Developer.hs b/Role/Developer.hs index deceb6d..a53e841 100644 --- a/Role/Developer.hs +++ b/Role/Developer.hs @@ -8,6 +8,8 @@ import Log import Crypto import CmdLine import WebSockets +import SessionID +import Pty import Control.Concurrent.Async import Control.Concurrent.STM @@ -19,8 +21,8 @@ import Data.List run :: DeveloperOpts -> IO () run os = runClientApp $ clientApp (ConnectMode (T.pack (debugUrl os))) developer -developer :: TChan (Message Entered) -> TChan (Message Seen) -> IO () -developer ichan ochan = withLogger "debug-me-developer.log" $ \logger -> do +developer :: TChan (Message Entered) -> TChan (Message Seen) -> SessionID -> IO () +developer ichan ochan _ = inRawMode $ withLogger "debug-me-developer.log" $ \logger -> do -- Start by reading the initial two messages from the user side, -- their session key and the startup message. sessionmsg <- atomically $ readTChan ochan diff --git a/Role/User.hs b/Role/User.hs index 9412843..efbbb24 100644 --- a/Role/User.hs +++ b/Role/User.hs @@ -10,6 +10,7 @@ import Session import Crypto import CmdLine import WebSockets +import SessionID import Control.Concurrent.Async import Control.Concurrent.STM @@ -19,6 +20,7 @@ import qualified Data.ByteString as B import Data.List.NonEmpty (NonEmpty(..), toList) import Data.Monoid import Data.Time.Clock.POSIX +import System.IO run :: UserOpts -> IO ExitCode run os = do @@ -27,12 +29,19 @@ run os = do sessionDone return exitstatus where - go cmd cmdparams startmsg = runWithPty cmd cmdparams $ \(p, ph) -> do - runClientApp $ clientApp (InitMode mempty) $ \ichan ochan -> do - uthread <- async (user startmsg p ichan ochan) - exitstatus <- waitForProcess ph - cancel uthread - return exitstatus + go cmd cmdparams startmsg = do + putStr "Connecting to debug-me server..." + hFlush stdout + runClientApp $ clientApp (InitMode mempty) $ \ichan ochan sid -> do + let url = sessionIDUrl sid "localhost" 8081 + putStrLn "" + putStrLn $ "Others can connect to this session by running: debug-me --debug " ++ url + hFlush stdout + runWithPty cmd cmdparams $ \(p, ph) -> do + uthread <- async (user startmsg p ichan ochan) + exitstatus <- waitForProcess ph + cancel uthread + return exitstatus shellCommand :: UserOpts -> IO (String, [String]) shellCommand os = return ("dash", []) |