From 9331a37b178c9142f5e864bbdc5434ea208946cc Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 30 Apr 2017 11:53:10 -0400 Subject: make url work without --debug --- CmdLine.hs | 31 +++++++++++++++++-------------- Role/Developer.hs | 5 +++-- Role/User.hs | 4 ++-- SessionID.hs | 10 ++++++---- TODO | 7 ++++++- debug-me.1 | 10 +++++----- debug-me.cabal | 1 + 7 files changed, 40 insertions(+), 28 deletions(-) diff --git a/CmdLine.hs b/CmdLine.hs index 7a023e7..a1eda5c 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -2,6 +2,7 @@ module CmdLine where import Data.Monoid import Options.Applicative +import Network.URI import Network.Wai.Handler.Warp (Port) data CmdLine = CmdLine @@ -19,21 +20,19 @@ data Mode | ControlMode ControlOpts data UserOpts = UserOpts - { cmdToRun :: Maybe (String, [String]) + { cmdToRun :: Maybe String } -type UrlString = String - data DeveloperOpts = DeveloperOpts - { debugUrl :: UrlString + { debugUrl :: URI } data DownloadOpts = DownloadOpts - { downloadUrl :: UrlString + { downloadUrl :: URI } data WatchOpts = WatchOpts - { watchUrl :: UrlString + { watchUrl :: URI } data GraphvizOpts = GraphvizOpts @@ -68,13 +67,14 @@ parseMode = (UserMode <$> parseuser) <|> (ControlMode <$> parsecontrol) where parseuser = UserOpts - <$> optional ((,) - <$> strArgument (metavar "cmd") - <*> many (strArgument (metavar "opts"))) + <$> optional (strOption + ( long "run" + <> metavar "command" + <> help "program to run (default: login shell)" + )) parsedeveloper = DeveloperOpts - <$> option str - ( long "debug" - <> metavar "url" + <$> argument readurl + ( metavar "url" <> help "debug a user on the given url" ) parsegraphviz = GraphvizOpts @@ -94,13 +94,13 @@ parseMode = (UserMode <$> parseuser) <> help "replay log file" ) parsedownload = DownloadOpts - <$> option str + <$> option readurl ( long "download" <> metavar "url" <> help "download log file from server" ) parsewatch = WatchOpts - <$> option str + <$> option readurl ( long "watch" <> metavar "url" <> help "display a debug-me session non-interactively" @@ -131,3 +131,6 @@ getCmdLine = execParser opts ( fullDesc <> header "debug-me - provable remote debugging sessions" ) + +readurl :: ReadM URI +readurl = eitherReader $ maybe (Left "url parse error") Right . parseURI diff --git a/Role/Developer.hs b/Role/Developer.hs index 960a204..fc54c9f 100644 --- a/Role/Developer.hs +++ b/Role/Developer.hs @@ -35,14 +35,15 @@ import Data.Maybe import Control.Monad import Data.Monoid import Data.Time.Clock.POSIX +import Network.URI run :: DeveloperOpts -> IO () run = run' developer . debugUrl -run' :: (TMVar (TVar DeveloperState) -> TMChan (Message Entered) -> TMChan AnyMessage -> SessionID -> IO ()) -> UrlString -> IO () +run' :: (TMVar (TVar DeveloperState) -> TMChan (Message Entered) -> TMChan AnyMessage -> SessionID -> IO ()) -> URI -> IO () run' runner url = do app <- do - let connect = ConnectMode (T.pack url) + let connect = ConnectMode $ T.pack $ show url dsv <- newEmptyTMVarIO let recentactivity = developerStateRecentActivity dsv return $ clientApp connect recentactivity Developer Just $ diff --git a/Role/User.hs b/Role/User.hs index 0929f74..d11c235 100644 --- a/Role/User.hs +++ b/Role/User.hs @@ -42,7 +42,7 @@ run os = fromMaybe (ExitFailure 101) <$> connect let url = sessionIDUrl sid "localhost" 8081 putStrLn "" putStrLn "Others can connect to this session and help you debug by running:" - putStrLn $ " debug-me --debug " ++ url + putStrLn $ " debug-me " ++ show url hFlush stdout withSessionLogger sid $ go ochan ichan usv controlinput controloutput go ochan ichan usv controlinput controloutput logger = do @@ -74,7 +74,7 @@ developerMessages (User _) = Nothing shellCommand :: UserOpts -> IO (String, [String]) shellCommand os = case cmdToRun os of - Just v -> return v + Just v -> return (v, []) Nothing -> maybe ("bash", ["-l"]) (, []) <$> lookupEnv "SHELL" -- | Log of recent Activity, with the most recent first. diff --git a/SessionID.hs b/SessionID.hs index c526849..170c0e5 100644 --- a/SessionID.hs +++ b/SessionID.hs @@ -15,8 +15,10 @@ import System.IO import System.Directory import Network.Wai.Handler.Warp (Port) import Data.List +import Data.Maybe import Data.UUID import Data.UUID.V4 +import Network.URI import Control.Concurrent.STM import Control.Exception @@ -72,7 +74,7 @@ withSessionID dir a = do cleanup hv = hClose =<< atomically (readTVar hv) go sid hv = a (hv, sid) -type UrlString = String - -sessionIDUrl :: SessionID -> String -> Port -> UrlString -sessionIDUrl (SessionID f) host port = "http://" ++ host ++ ":" ++ show port ++ "/" ++ f +sessionIDUrl :: SessionID -> String -> Port -> URI +sessionIDUrl (SessionID f) host port = + fromMaybe (error "internal url parse failure") $ parseURI $ + "http://" ++ host ++ ":" ++ show port ++ "/" ++ f diff --git a/TODO b/TODO index f31d45d..50bd348 100644 --- a/TODO +++ b/TODO @@ -1,6 +1,6 @@ * Multiple --downloads at the same time or close together fail with "thread blocked indefinitely in an STM transaction" - Also see it occasionally with --debug. + Also see it occasionally when connecting with what was --debug. * The current rules for when an Activity Entered is accepted allow it to refer to an older activity than the last one. If echoing is disabled, two Activity Entered could be sent, each pointing at the most recent @@ -57,6 +57,7 @@ in the debug-me session. * When the user presses control-s, before forwarding it to the terminal, stop accepting any developer input. Control-s again to resume. + (Or, add buttons to the control window to do this.) * Make control-backslash immediately end the debug-me session. * Need to spin up a debug-me server and make debug-me use it by default, not localhost. @@ -64,6 +65,10 @@ Low priority: +* Color the control window background to distinguish it from the shell + window. Could even use a curses toolkit to draw the control window, and + make it have buttons, etc. Make the control window easy to use, and all + features discoverable.. * Add a mode that, given a log file, displays what developer(s) gpg keys signed activity in the log file. For use when a developer did something wrong, to examine the proof of malfesence. diff --git a/debug-me.1 b/debug-me.1 index 1bce965..3bc1fee 100644 --- a/debug-me.1 +++ b/debug-me.1 @@ -36,13 +36,13 @@ 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. .SH USER OPTIONS -.IP "-- cmd opts" +.IP "--run cmd" Normally debug-me will run your login shell. To run some other command, -pass the command and any options after "--". +use this option. .SH DEVELOPER OPTIONS -.IP "--debug url" -Connect to a debug-me session on the specified url. The developer runs -debug-me with this option to see and interact with the user's bug. +.IP url +Connect to a debug-me session on the specified url, to see and interact +with the user's bug. .IP "--watch url" Connect to a debug-me session on the specified url and display what happens in the session. Your keystrokes will not be sent to the session. diff --git a/debug-me.cabal b/debug-me.cabal index 0aa58d2..dd64c01 100644 --- a/debug-me.cabal +++ b/debug-me.cabal @@ -77,6 +77,7 @@ Executable debug-me , protobuf (>= 0.2) , cereal (>= 0.5) , utf8-string (>= 1.0) + , network-uri (>= 2.6) Other-Modules: ControlWindow ControlSocket -- cgit v1.2.3