summaryrefslogtreecommitdiffhomepage
path: root/Role
diff options
context:
space:
mode:
authorJoey Hess <joeyh@joeyh.name>2017-04-29 14:46:45 -0400
committerJoey Hess <joeyh@joeyh.name>2017-04-29 14:51:26 -0400
commita61df1522ddf8a36839cf1180d3b16e354459e9a (patch)
tree0e78f72714701b8cd7f32591c921e4826fcf1ddd /Role
parent237b94f6c687675215f78fba28d7e003a2b9ab7d (diff)
downloaddebug-me-a61df1522ddf8a36839cf1180d3b16e354459e9a.tar.gz
user gpg key checking and prompting done!
Diffstat (limited to 'Role')
-rw-r--r--Role/User.hs67
1 files changed, 26 insertions, 41 deletions
diff --git a/Role/User.hs b/Role/User.hs
index bbf563c..0929f74 100644
--- a/Role/User.hs
+++ b/Role/User.hs
@@ -202,33 +202,13 @@ sendPtyInput ichan ochan controlinput p us logger = go
go
Just (InputMessage msg@(ControlMessage (Control c _))) -> do
logger $ Developer msg
- case c of
- SessionKey pk -> do
- checkDeveloperPublicKey ochan us logger pk
- go
- ChatMessage _ _ -> do
- atomically $ writeTMChan controlinput (ControlInputAction c)
- go
- Rejected r -> error $ "User side received a Rejected: " ++ show r
- SessionKeyAccepted _ -> error "User side received a SessionKeyAccepted"
- SessionKeyRejected _ -> error "User side received a SessionKeyRejected"
+ atomically $ writeTMChan controlinput (ControlInputAction c)
+ go
Just (RejectedMessage rej) -> do
logger $ User rej
go
Just (BadlySignedMessage _) -> go
-sendControlOutput :: TMChan ControlOutput -> TMChan (Message Seen) -> TVar UserState -> Logger -> IO ()
-sendControlOutput controloutput ochan us logger = loop
- where
- loop = go =<< atomically (readTMChan controloutput)
- go Nothing = return ()
- go (Just ControlWindowOpened) = loop
- go (Just (ControlOutputAction c)) = do
- now <- getPOSIXTime
- l <- atomically $ sendDeveloper ochan us c now
- logger (User l)
- loop
-
data Input
= InputMessage (Message Entered)
| RejectedMessage (Message Seen)
@@ -276,25 +256,6 @@ getDeveloperMessage' msg ochan us now = do
return (InputMessage msg)
else return (BadlySignedMessage msg)
--- | Check if the public key a developer presented is one we want to use,
--- and if so, add it to the sigVerifier.
-checkDeveloperPublicKey :: TMChan (Message Seen) -> TVar UserState -> Logger -> PerhapsSigned PublicKey -> IO ()
-checkDeveloperPublicKey ochan us logger spk = do
- now <- getPOSIXTime
- -- TODO check gpg sig..
- msg <- atomically $ do
- st <- readTVar us
- let sv = sigVerifier st
- let sv' = sv `mappend` mkSigVerifier pk
- let st' = st { sigVerifier = sv' }
- writeTVar us st'
- sendDeveloper ochan us (SessionKeyAccepted pk) now
- logger $ User msg
- where
- pk = case spk of
- GpgSigned k _ -> k
- UnSigned k -> k
-
-- | Truncate the Backlog to remove entries older than the one
-- that the Activity Entered refers to, but only if the referred
-- to Activity is an Activity Seen.
@@ -357,3 +318,27 @@ isLegalEntered (Activity a (Just hp) _ _) us
(lastact :| bl) = backLog us
getseen (User (ActivityMessage as)) = seenData $ activity as
getseen _ = mempty
+
+-- | Forward messages from the control window to the developer.
+--
+-- When the control window sends a SessionKeyAccepted, add it to the
+-- sigVerifier.
+sendControlOutput :: TMChan ControlOutput -> TMChan (Message Seen) -> TVar UserState -> Logger -> IO ()
+sendControlOutput controloutput ochan us logger = loop
+ where
+ loop = go =<< atomically (readTMChan controloutput)
+ go Nothing = return ()
+ go (Just ControlWindowOpened) = loop
+ go (Just (ControlOutputAction c)) = do
+ case c of
+ SessionKeyAccepted pk -> atomically $ do
+ st <- readTVar us
+ let sv = sigVerifier st
+ let sv' = sv `mappend` mkSigVerifier pk
+ let st' = st { sigVerifier = sv' }
+ writeTVar us st'
+ _ -> return ()
+ now <- getPOSIXTime
+ l <- atomically $ sendDeveloper ochan us c now
+ logger (User l)
+ loop