summaryrefslogtreecommitdiffhomepage
path: root/Role
diff options
context:
space:
mode:
authorJoey Hess <joeyh@joeyh.name>2017-04-24 17:13:28 -0400
committerJoey Hess <joeyh@joeyh.name>2017-04-24 17:13:28 -0400
commit17d76b2a59d496a2ffd6d2199b1c6ad563b0bb5b (patch)
tree3c8f21c0b17502e504396d6b42ff76be2fa51668 /Role
parent337091314588b67620e61c2c80cbb6180f07d440 (diff)
downloaddebug-me-17d76b2a59d496a2ffd6d2199b1c6ad563b0bb5b.tar.gz
fix downloader and watcher
Diffstat (limited to 'Role')
-rw-r--r--Role/Developer.hs18
-rw-r--r--Role/Downloader.hs5
-rw-r--r--Role/Watcher.hs3
3 files changed, 13 insertions, 13 deletions
diff --git a/Role/Developer.hs b/Role/Developer.hs
index 64ff094..1cc5a10 100644
--- a/Role/Developer.hs
+++ b/Role/Developer.hs
@@ -36,7 +36,8 @@ userMessages (Developer _) = Nothing
developer :: TMChan (Message Entered) -> TMChan (Message Seen) -> SessionID -> IO ()
developer ichan ochan _ = withLogger "debug-me-developer.log" $ \logger -> do
- devstate <- processSessionStart ochan logger
+ (devstate, startoutput) <- processSessionStart ochan logger
+ emitOutput startoutput
ok <- authUser ichan ochan devstate logger
if ok
then inRawMode $ void $
@@ -115,7 +116,7 @@ authUser ichan ochan devstate logger = do
waitresp pk
where
waitresp pk = do
- (o, msg) <- fromMaybe (error "No response from server to our session key")
+ (o, msg) <- fromMaybe (error "Looks like that debug-me session is over.")
<$> atomically (getUserMessage ochan devstate)
logger $ User msg
emitOutput o
@@ -231,7 +232,7 @@ isLegalSeen act@(Activity (Seen (Val b)) (Just hp) _) ds
-- | Start by reading the initial two messages from the user side,
-- their session key and the startup message.
-processSessionStart :: TMChan (Message Seen) -> Logger -> IO (TVar DeveloperState)
+processSessionStart :: TMChan (Message Seen) -> Logger -> IO (TVar DeveloperState, Output)
processSessionStart ochan logger = do
sessionmsg <- fromMaybe (error "Did not get session initialization message")
<$> atomically (readTMChan ochan)
@@ -246,15 +247,13 @@ processSessionStart ochan logger = do
startmsg <- fromMaybe (error "Did not get session startup message")
<$> atomically (readTMChan ochan)
logger $ User startmsg
- starthash <- case startmsg of
+ let (starthash, output) = case startmsg of
ActivityMessage act@(Activity (Seen (Val b)) Nothing _)
- | verifySigned sigverifier act -> do
- B.hPut stdout b
- hFlush stdout
- return (hash act)
+ | verifySigned sigverifier act ->
+ (hash act, TtyOutput b)
_ -> error $ "Unexpected startup message: " ++ show startmsg
sk <- genMySessionKey
- newTVarIO $ DeveloperState
+ st <- newTVarIO $ DeveloperState
{ lastSeen = starthash
, sentSince = mempty
, enteredSince = mempty
@@ -262,3 +261,4 @@ processSessionStart ochan logger = do
, developerSessionKey = sk
, developerSigVerifier = sigverifier
}
+ return (st, output)
diff --git a/Role/Downloader.hs b/Role/Downloader.hs
index 55d7b63..ede11a7 100644
--- a/Role/Downloader.hs
+++ b/Role/Downloader.hs
@@ -18,7 +18,7 @@ downloader _ichan ochan sid = do
putStrLn $ "Starting download to " ++ logfile
putStrLn "(Will keep downloading until the debug-me session is done.)"
withLogger logfile $ \logger -> do
- st <- processSessionStart ochan logger
+ (st, _startoutput) <- processSessionStart ochan logger
go logger st
where
go logger st = do
@@ -29,5 +29,4 @@ downloader _ichan ochan sid = do
_ <- logger $ User msg
case o of
ProtocolError e -> error ("Protocol error: " ++ e)
- _ -> return ()
- go logger st
+ _ -> go logger st
diff --git a/Role/Watcher.hs b/Role/Watcher.hs
index 6ed1a6b..ddffa79 100644
--- a/Role/Watcher.hs
+++ b/Role/Watcher.hs
@@ -15,7 +15,8 @@ run = run' watcher . watchUrl
watcher :: TMChan (Message Entered) -> TMChan (Message Seen) -> SessionID -> IO ()
watcher _ichan ochan _ = inRawMode $ do
- st <- processSessionStart ochan nullLogger
+ (st, startoutput) <- processSessionStart ochan nullLogger
+ emitOutput startoutput
go st
where
go st = do