diff options
author | Joey Hess <joeyh@joeyh.name> | 2017-04-30 12:54:50 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2017-04-30 12:55:28 -0400 |
commit | 1bda1faf65c2ccf4e6a0dc349ddbc0f97b67b1da (patch) | |
tree | 17fdff934f71bc2fbb643bb3ed96e7da757e5bb5 | |
parent | 263b547ad43dff0e4948e860ac8d1cfa4f4cf0f1 (diff) | |
download | debug-me-1bda1faf65c2ccf4e6a0dc349ddbc0f97b67b1da.tar.gz |
log remote logs to subdir
-rw-r--r-- | Log.hs | 7 | ||||
-rw-r--r-- | Role/Developer.hs | 2 | ||||
-rw-r--r-- | Role/User.hs | 3 | ||||
-rw-r--r-- | Role/Watcher.hs | 2 |
4 files changed, 8 insertions, 6 deletions
@@ -57,11 +57,12 @@ type Logger = AnyMessage -> IO () logDir :: IO FilePath logDir = (</> "log") <$> dotDir -withSessionLogger :: SessionID -> (Logger -> IO a) -> IO a -withSessionLogger sessionid a = bracket setup cleanup go +withSessionLogger :: (Maybe FilePath) -> SessionID -> (Logger -> IO a) -> IO a +withSessionLogger subdir sessionid a = bracket setup cleanup go where setup = do - dir <- logDir + basedir <- logDir + let dir = maybe basedir (basedir </>) subdir createDirectoryIfMissing False dir return $ sessionLogFile dir sessionid cleanup logfile = putStrLn $ "** debug-me session was logged to " ++ logfile diff --git a/Role/Developer.hs b/Role/Developer.hs index d210e50..36cc600 100644 --- a/Role/Developer.hs +++ b/Role/Developer.hs @@ -51,7 +51,7 @@ run' runner url = do void $ runClientApp app developer :: TMVar (TVar DeveloperState) -> TMChan (Message Entered) -> TMChan AnyMessage -> SessionID -> IO () -developer dsv ichan ochan sid = withSessionLogger sid $ \logger -> do +developer dsv ichan ochan sid = withSessionLogger (Just "remote") sid $ \logger -> do sk <- genMySessionKey (controlinput, controloutput) <- openControlWindow displayInControlWindow controlinput diff --git a/Role/User.hs b/Role/User.hs index d11c235..1e842d0 100644 --- a/Role/User.hs +++ b/Role/User.hs @@ -44,7 +44,8 @@ run os = fromMaybe (ExitFailure 101) <$> connect putStrLn "Others can connect to this session and help you debug by running:" putStrLn $ " debug-me " ++ show url hFlush stdout - withSessionLogger sid $ go ochan ichan usv controlinput controloutput + withSessionLogger Nothing sid $ + go ochan ichan usv controlinput controloutput go ochan ichan usv controlinput controloutput logger = do (cmd, cmdparams) <- shellCommand os runWithPty cmd cmdparams $ \(p, ph) -> do diff --git a/Role/Watcher.hs b/Role/Watcher.hs index f314b46..0867da1 100644 --- a/Role/Watcher.hs +++ b/Role/Watcher.hs @@ -15,7 +15,7 @@ run :: WatchOpts -> IO () run = run' watcher . watchUrl watcher :: TMVar (TVar DeveloperState) -> TMChan (Message Entered) -> TMChan AnyMessage -> SessionID -> IO () -watcher dsv _ichan ochan sid = withSessionLogger sid $ \logger -> inRawMode $ do +watcher dsv _ichan ochan sid = withSessionLogger (Just "remote") sid $ \logger -> inRawMode $ do sk <- genMySessionKey (st, startoutput) <- processSessionStart sk ochan logger dsv emitOutput startoutput |