diff options
author | Joey Hess <joeyh@joeyh.name> | 2017-04-28 18:50:41 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2017-04-28 18:50:41 -0400 |
commit | f65034502f2b94f2474c65ee968e9eb9861c2d93 (patch) | |
tree | 87f97a9b38bf9af3ba32636d341019986a61be10 /Role | |
parent | 175d89cb3d6914ddda68f3294ab172e29784d16d (diff) | |
download | debug-me-f65034502f2b94f2474c65ee968e9eb9861c2d93.tar.gz |
reorder "Using gpg to sign the debug-me session key" message before session start
Diffstat (limited to 'Role')
-rw-r--r-- | Role/Developer.hs | 16 | ||||
-rw-r--r-- | Role/Downloader.hs | 4 | ||||
-rw-r--r-- | Role/Watcher.hs | 4 |
3 files changed, 14 insertions, 10 deletions
diff --git a/Role/Developer.hs b/Role/Developer.hs index c48c131..9400ddf 100644 --- a/Role/Developer.hs +++ b/Role/Developer.hs @@ -49,10 +49,12 @@ run' runner url = do developer :: TMVar (TVar DeveloperState) -> TMChan (Message Entered) -> TMChan AnyMessage -> SessionID -> IO () developer dsv ichan ochan sid = withSessionLogger sid $ \logger -> do + sk <- genMySessionKey + spk <- myPublicKey sk (GpgSign True) (controlinput, controloutput) <- openControlWindow - (devstate, startoutput) <- processSessionStart ochan logger dsv + (devstate, startoutput) <- processSessionStart sk ochan logger dsv emitOutput startoutput - ok <- authUser ichan ochan devstate logger + ok <- authUser spk ichan ochan devstate logger if ok then inRawMode $ void $ sendTtyInput ichan devstate logger @@ -171,10 +173,9 @@ sendTtyOutput ochan devstate controlinput logger = go -- | Present our session key to the user. -- Wait for them to accept or reject it, while displaying any Seen data -- in the meantime. -authUser :: TMChan (Message Entered) -> TMChan AnyMessage -> TVar DeveloperState -> Logger -> IO Bool -authUser ichan ochan devstate logger = do +authUser :: PerhapsSigned PublicKey -> TMChan (Message Entered) -> TMChan AnyMessage -> TVar DeveloperState -> Logger -> IO Bool +authUser spk ichan ochan devstate logger = do ds <- atomically $ readTVar devstate - spk <- myPublicKey (developerSessionKey ds) (GpgSign True) let msg = ControlMessage $ mkSigned (developerSessionKey ds) (Control (SessionKey spk)) atomically $ writeTMChan ichan msg @@ -341,8 +342,8 @@ isLegalSeen act@(Activity (Seen (Val b)) (Just hp) _ _) ds ts -- | Start by reading the initial two messages from the user, -- their session key and the startup message. -processSessionStart :: TMChan AnyMessage -> Logger -> TMVar (TVar DeveloperState) -> IO (TVar DeveloperState, Output) -processSessionStart ochan logger dsv = do +processSessionStart :: MySessionKey -> TMChan AnyMessage -> Logger -> TMVar (TVar DeveloperState) -> IO (TVar DeveloperState, Output) +processSessionStart sk ochan logger dsv = do sessionmsg <- fromMaybe (error "Did not get session initialization message") <$> atomically (readTMChan ochan) logger sessionmsg @@ -356,7 +357,6 @@ processSessionStart ochan logger dsv = do then return sv else error "Badly signed session initialization message" _ -> error $ "Unexpected session initialization message: " ++ show sessionmsg - sk <- genMySessionKey ts <- getPOSIXTime st <- newTVarIO $ DeveloperState { lastSeen = hash () diff --git a/Role/Downloader.hs b/Role/Downloader.hs index 4d5f6cc..c3d6b73 100644 --- a/Role/Downloader.hs +++ b/Role/Downloader.hs @@ -4,6 +4,7 @@ import Types import Log import CmdLine import SessionID +import Crypto import Role.Developer import Control.Concurrent.STM @@ -19,7 +20,8 @@ downloader dsv _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, _startoutput) <- processSessionStart ochan logger dsv + sk <- genMySessionKey + (st, _startoutput) <- processSessionStart sk ochan logger dsv go logger st where go logger st = do diff --git a/Role/Watcher.hs b/Role/Watcher.hs index 7b809f0..dd49621 100644 --- a/Role/Watcher.hs +++ b/Role/Watcher.hs @@ -5,6 +5,7 @@ import Log import Pty import CmdLine import SessionID +import Crypto import Role.Developer import Control.Concurrent.STM @@ -16,7 +17,8 @@ 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 - (st, startoutput) <- processSessionStart ochan logger dsv + sk <- genMySessionKey + (st, startoutput) <- processSessionStart sk ochan logger dsv emitOutput startoutput go logger st where |