diff options
-rw-r--r-- | CmdLine.hs | 2 | ||||
-rw-r--r-- | ControlSocket.hs | 20 | ||||
-rw-r--r-- | ControlWindow.hs (renamed from Control.hs) | 25 | ||||
-rw-r--r-- | Role/Developer.hs | 1 | ||||
-rw-r--r-- | Role/User.hs | 1 | ||||
-rw-r--r-- | debug-me.cabal | 2 | ||||
-rw-r--r-- | debug-me.hs | 4 |
7 files changed, 31 insertions, 24 deletions
@@ -52,7 +52,7 @@ data ServerOpts = ServerOpts } data ControlOpts = ControlOpts - { controlWindow :: Bool + { controlWindowEnabled :: Bool } parseCmdLine :: Parser CmdLine diff --git a/ControlSocket.hs b/ControlSocket.hs index 8aa68cd..6512f4b 100644 --- a/ControlSocket.hs +++ b/ControlSocket.hs @@ -36,29 +36,15 @@ instance FromJSON ControlOutput defaultSocketFile :: IO FilePath defaultSocketFile = (</> "control") <$> dotDir --- | Opens the control window, or if that can't be done, tells the user --- to run debug-me --control. --- --- Returns once either of the TMChans is closed. -openControlWindow :: IO (TMChan ControlInput, TMChan ControlOutput) -openControlWindow = do - socketfile <- defaultSocketFile +bindSocket :: FilePath -> IO S.Socket +bindSocket socketfile = do -- Delete any existing socket file. _ <- try (removeLink socketfile) :: IO (Either IOException ()) soc <- S.socket S.AF_UNIX S.Stream S.defaultProtocol S.bind soc (S.SockAddrUnix socketfile) setFileMode socketfile (unionFileModes ownerWriteMode ownerReadMode) S.listen soc 2 - ichan <- newTMChanIO - ochan <- newTMChanIO - _ <- async $ serveControlSocket soc ichan ochan - -- Wait for message from control process. - putStrLn "You need to open another shell prompt, and run: debug-me --control" - v <- atomically $ readTMChan ochan - case v of - Just ControlWindowOpened -> return () - _ -> error "unexpected message from control process" - return (ichan, ochan) + return soc -- | Serve connections to the control socket, feeding data between it and -- the TMChans. diff --git a/Control.hs b/ControlWindow.hs index 55cfc07..c22092f 100644 --- a/Control.hs +++ b/ControlWindow.hs @@ -2,7 +2,7 @@ -- | debug-me session control window -module Control where +module ControlWindow where import Types import CmdLine @@ -19,8 +19,8 @@ import Data.ByteString.UTF8 (fromString) import Data.Monoid import Prelude -control :: ControlOpts -> IO () -control _ = do +controlWindow :: ControlOpts -> IO () +controlWindow _ = do putStrLn "** debug-me session control and chat window" socketfile <- defaultSocketFile ichan <- newTMChanIO @@ -35,6 +35,25 @@ control _ = do `race` collectOutput ochan promptchan responsechan return () +-- | Opens the control window, or if that can't be done, tells the user +-- to run debug-me --control. +-- +-- Returns once either of the TMChans is closed. +openControlWindow :: IO (TMChan ControlInput, TMChan ControlOutput) +openControlWindow = do + socketfile <- defaultSocketFile + soc <- bindSocket socketfile + ichan <- newTMChanIO + ochan <- newTMChanIO + _ <- async $ serveControlSocket soc ichan ochan + -- Wait for message from control process. + putStrLn "You need to open another shell prompt, and run: debug-me --control" + v <- atomically $ readTMChan ochan + case v of + Just ControlWindowOpened -> return () + _ -> error "unexpected message from control process" + return (ichan, ochan) + type Prompt = () type Response = L.ByteString diff --git a/Role/Developer.hs b/Role/Developer.hs index 448e04e..c48c131 100644 --- a/Role/Developer.hs +++ b/Role/Developer.hs @@ -20,6 +20,7 @@ import SessionID import Pty import PrevActivity import ControlSocket +import ControlWindow import Control.Concurrent.Async import Control.Concurrent.STM diff --git a/Role/User.hs b/Role/User.hs index 24d85c3..d1e4975 100644 --- a/Role/User.hs +++ b/Role/User.hs @@ -13,6 +13,7 @@ import WebSockets import SessionID import PrevActivity import ControlSocket +import ControlWindow import Control.Concurrent.Async import Control.Concurrent.STM diff --git a/debug-me.cabal b/debug-me.cabal index 7d8cbd7..4ca97d5 100644 --- a/debug-me.cabal +++ b/debug-me.cabal @@ -75,7 +75,7 @@ Executable debug-me , cereal (>= 0.5) , utf8-string (>= 1.0) Other-Modules: - Control + ControlWindow ControlSocket CmdLine Crypto diff --git a/debug-me.hs b/debug-me.hs index 98d2d27..dc40fc3 100644 --- a/debug-me.hs +++ b/debug-me.hs @@ -4,7 +4,7 @@ import CmdLine import Graphviz import Replay import Server -import Control +import ControlWindow import qualified Role.User import qualified Role.Developer import qualified Role.Downloader @@ -24,4 +24,4 @@ main = withSocketsDo $ do GraphvizMode o -> graphviz o ReplayMode o -> replay o ServerMode o -> server o - ControlMode o -> control o + ControlMode o -> controlWindow o |