From f65034502f2b94f2474c65ee968e9eb9861c2d93 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 28 Apr 2017 18:50:41 -0400 Subject: reorder "Using gpg to sign the debug-me session key" message before session start --- Role/Developer.hs | 16 ++++++++-------- Role/Downloader.hs | 4 +++- Role/Watcher.hs | 4 +++- 3 files changed, 14 insertions(+), 10 deletions(-) (limited to 'Role') 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 -- cgit v1.2.3