diff options
Diffstat (limited to 'Role')
| -rw-r--r-- | Role/Developer.hs | 45 | ||||
| -rw-r--r-- | Role/User.hs | 50 |
2 files changed, 66 insertions, 29 deletions
diff --git a/Role/Developer.hs b/Role/Developer.hs index 604ac6d..d8d9d2c 100644 --- a/Role/Developer.hs +++ b/Role/Developer.hs @@ -108,8 +108,10 @@ data DeveloperState = DeveloperState , enteredSince :: [Hash] -- ^ Messages we've sent since the last Seen. , lastActivity :: Hash + -- ^ Last Entered or Seen activity , lastActivityTs :: POSIXTime - -- ^ Last message sent or received. + , lastEntered :: Maybe Hash + -- ^ Last Entered activity (either from us or another developer). , fromOtherDevelopersSince :: [Hash] -- ^ Messages received from other developers since the last Seen. -- (The next Seen may chain from one of these.) @@ -126,7 +128,8 @@ data DeveloperState = DeveloperState developerStateRecentActivity :: TVar DeveloperState -> RecentActivity developerStateRecentActivity devstate = do st <- readTVar devstate - let hs = lastSeen st : enteredSince st ++ fromOtherDevelopersSince st + let hs = lastSeen st : fromMaybe (lastSeen st) (lastEntered st) + : enteredSince st ++ fromOtherDevelopersSince st return (userSigVerifier st <> developerSigVerifier st, hs) -- | Read things typed by the developer, and forward them to the TMChan. @@ -154,6 +157,7 @@ sendTtyInput ichan devstate logger = go let act = mkSigned (developerSessionKey ds) $ Activity entered (Just $ lastActivity ds) + (lastEntered ds) (mkElapsedTime (lastActivityTs ds) ts) writeTMChan ichan (ActivityMessage act) let acth = hash act @@ -162,6 +166,7 @@ sendTtyInput ichan devstate logger = go , enteredSince = enteredSince ds ++ [acth] , lastActivity = acth , lastActivityTs = ts + , lastEntered = Just acth } writeTVar devstate ds' return act @@ -203,11 +208,11 @@ sendTtyOutput ochan devstate controlinput logger = go forwardcontrol msg = case msg of User (ControlMessage c) -> fwd c Developer (ControlMessage c) -> case control c of - Rejected _ -> return () - SessionKey _ -> return () - SessionKeyAccepted _ -> return () - SessionKeyRejected _ -> return () - ChatMessage _ _ -> fwd c + EnteredRejected {} -> return () + SessionKey {} -> return () + SessionKeyAccepted {} -> return () + SessionKeyRejected {} -> return () + ChatMessage {} -> fwd c _ -> return () fwd = atomically . writeTMChan controlinput . ControlInputAction . control @@ -308,20 +313,21 @@ getServerMessage ochan devstate ts = do ignore = getServerMessage ochan devstate ts - processuser ds (ActivityMessage act@(Activity (Seen (Val b)) _ _ _)) = do + processuser ds (ActivityMessage act@(Activity (Seen (Val b)) _ _ _ _)) = do let (legal, ds') = isLegalSeen act ds ts if legal then do writeTVar devstate ds' return (TtyOutput b) else return (ProtocolError ds $ "Illegal Seen value: " ++ show act) - processuser ds (ControlMessage (Control (Rejected _) _)) = do + processuser ds (ControlMessage (Control (er@EnteredRejected {}) _)) = do -- When they rejected a message we sent, -- anything we sent subsequently will -- also be rejected, so forget about it. let ds' = ds { sentSince = mempty , enteredSince = mempty + , lastEntered = enteredLastAccepted er } writeTVar devstate ds' return Beep @@ -345,8 +351,8 @@ getServerMessage ochan devstate ts = do -- -- Does not check the signature. isLegalSeen :: Activity Seen -> DeveloperState -> POSIXTime -> (Bool, DeveloperState) -isLegalSeen (Activity _ Nothing _ _) ds _ = (False, ds) -isLegalSeen act@(Activity (Seen (Val b)) (Just hp) _ _) ds ts +isLegalSeen (Activity _ Nothing _ _ _) ds _ = (False, ds) +isLegalSeen act@(Activity (Seen (Val b)) (Just hp) _ _ _) ds ts -- Does it chain to the last Seen activity or to -- something sent by another developer since the last Seen? | hp == lastSeen ds || hp `elem` fromOtherDevelopersSince ds = @@ -364,6 +370,7 @@ isLegalSeen act@(Activity (Seen (Val b)) (Just hp) _ _) ds ts , enteredSince = es' , lastActivity = acth , lastActivityTs = ts + , lastEntered = newlastentered , fromOtherDevelopersSince = mempty } -- Does it chain to something we've entered since the last Seen @@ -384,12 +391,25 @@ isLegalSeen act@(Activity (Seen (Val b)) (Just hp) _ _) ds ts , enteredSince = es' , lastActivity = acth , lastActivityTs = ts + , lastEntered = newlastentered , fromOtherDevelopersSince = mempty } where acth = hash act yes ds' = (True, ds') + -- If there are multiple developers, need to set our lastEntered + -- to the prevEntered from the Activity Seen, so we can follow on to + -- another developer's activity. + -- + -- But, if there's lag, we may have sent some Activity Entered + -- that had not reached the user yet when it constructed the + -- Activity Seen, so check if the prevEntered is one of the + -- things we've enteredSince; if so keep our lastEntered. + newlastentered = case prevEntered act of + Just v | v `notElem` enteredSince ds -> Just v + _ -> lastEntered ds + -- | Start by reading the initial two messages from the user, -- their session key and the startup message. processSessionStart :: MySessionKey -> TMChan (MissingHashes AnyMessage) -> Logger -> TMVar (TVar DeveloperState) -> IO (TVar DeveloperState, Output) @@ -412,7 +432,7 @@ processSessionStart sk ochan logger dsv = do <$> atomically (readTMChan ochan) logger startmsg let (starthash, output) = case startmsg of - User (ActivityMessage act@(Activity (Seen (Val b)) Nothing _ _)) + User (ActivityMessage act@(Activity (Seen (Val b)) Nothing Nothing _ _)) | verifySigned sigverifier act -> (hash act, TtyOutput b) | otherwise -> @@ -424,6 +444,7 @@ processSessionStart sk ochan logger dsv = do , enteredSince = mempty , lastActivity = starthash , lastActivityTs = ts + , lastEntered = Nothing , fromOtherDevelopersSince = mempty , developerSessionKey = sk , userSigVerifier = sigverifier diff --git a/Role/User.hs b/Role/User.hs index e1138c2..a7e4843 100644 --- a/Role/User.hs +++ b/Role/User.hs @@ -12,6 +12,7 @@ import Pty import Memory import Log import Session +import Hash import Crypto import Gpg import CmdLine @@ -98,13 +99,15 @@ data UserState = UserState , userSessionKey :: MySessionKey , sigVerifier :: SigVerifier , lastSeenTs :: POSIXTime + , lastAcceptedEntered :: Maybe Hash } -- | RecentActivity that uses the UserState. userStateRecentActivity :: TVar UserState -> RecentActivity userStateRecentActivity us = do st <- readTVar us - let hs = mapMaybe loggedHash $ toList $ backLog st + let hs = catMaybes $ lastAcceptedEntered st + : map loggedHash (toList (backLog st)) return (sigVerifier st, hs) -- | Start by establishing our session key, and displaying the starttxt. @@ -118,7 +121,9 @@ startProtocol starttxt ochan logger = do let c = mkSigned sk $ Control (SessionKey pk) initialmessage $ ControlMessage c let starttxt' = rawLine starttxt - let act = mkSigned sk $ Activity (Seen (Val starttxt')) Nothing mempty + let act = mkSigned sk $ Activity + (Seen (Val starttxt')) + Nothing Nothing mempty let startmsg = ActivityMessage act B.hPut stdout starttxt' hFlush stdout @@ -130,6 +135,7 @@ startProtocol starttxt ochan logger = do , userSessionKey = sk , sigVerifier = mempty , lastSeenTs = now + , lastAcceptedEntered = Nothing } -- | Forward things the user types to the Pty. @@ -177,6 +183,7 @@ instance SendableToDeveloper Seen where mkSigned (userSessionKey st) $ Activity seen (loggedHash prev) + (lastAcceptedEntered st) (mkElapsedTime (lastSeenTs st) now) let l = mkLog (User msg) now writeTMChan ochan msg @@ -214,14 +221,15 @@ sendPtyInput ichan ochan controlinput p us logger = go logger $ Developer msg atomically $ writeTMChan controlinput (ControlInputAction c) go - Just (RejectedMessage rej) -> do + Just (RejectedMessage ent rej) -> do + logger $ Developer ent logger $ User rej go Just (BadlySignedMessage _) -> go data Input = InputMessage (Message Entered) - | RejectedMessage (Message Seen) + | RejectedMessage (Message Entered) (Message Seen) | BadlySignedMessage (Message Entered) -- Get message from developer, verify its signature is from a developer we @@ -258,11 +266,18 @@ getDeveloperMessage' (MissingHashes wiremsg) ochan us now = do if isLegalEntered entered (st { backLog = bl' }) then do let l = mkLog (Developer msg) now - writeTVar us (st { backLog = l :| toList bl' }) + writeTVar us $ st + { backLog = l :| toList bl' + , lastAcceptedEntered = Just (hash entered) + } return (InputMessage msg) else do - let reject = Rejected entered - RejectedMessage <$> sendDeveloper ochan us reject now + let reject = EnteredRejected + { enteredRejected = hash entered + , enteredLastAccepted = lastAcceptedEntered st + } + RejectedMessage msg + <$> sendDeveloper ochan us reject now ControlMessage (Control _ _) -> return (InputMessage msg) else return (BadlySignedMessage msg) @@ -278,7 +293,7 @@ getDeveloperMessage' (MissingHashes wiremsg) ochan us now = do -- If the Activity refers to an item not in the backlog, no truncation is -- done. truncateBacklog :: Backlog -> Activity Entered -> Backlog -truncateBacklog (b :| l) (Activity _ (Just hp) _ _) +truncateBacklog (b :| l) (Activity _ (Just hp) _ _ _) | truncationpoint b = b :| [] | otherwise = b :| go [] l where @@ -288,7 +303,7 @@ truncateBacklog (b :| l) (Activity _ (Just hp) _ _) | otherwise = go (x:c) xs truncationpoint x@(Log { loggedMessage = User {}}) = loggedHash x == Just hp truncationpoint _ = False -truncateBacklog bl (Activity _ Nothing _ _) = bl +truncateBacklog bl (Activity _ Nothing _ _ _) = bl -- | To avoid DOS attacks that try to fill up the backlog and so use all -- memory, don't let the backlog contain more than 1000 items, or @@ -302,23 +317,24 @@ reduceBacklog (b :| l) = b :| go 0 (take 1000 l) | n > 16777216 = [] | otherwise = x : go (n + dataSize x) xs --- | Entered activity is legal when it points to the last logged activity, --- because this guarantees that the person who entered it saw --- the current state of the system before manipulating it. +-- | Entered activity is legal when its prevActivity points to the last +-- logged activity, because this guarantees that the person who entered +-- it saw the current state of the system before manipulating it. -- -- To support typeahead on slow links, some echoData may be provided -- in the Entered activity. If the Entered activity points --- to an older activity, then the echoData must match the +-- to an older prevActivity, then the echoData must match the -- concatenation of all Seen activities after that one, up to the -- last logged activity. -- --- Activities that do not enter data point to the first message --- sent in the debug-me session. +-- Also, the prevEntered field must point to the last accepted +-- Entered activity. -- -- Does not check the signature. isLegalEntered :: Activity Entered -> UserState -> Bool -isLegalEntered (Activity _ Nothing _ _) _ = False -isLegalEntered (Activity a (Just hp) _ _) us +isLegalEntered (Activity _ Nothing _ _ _) _ = False +isLegalEntered (Activity a (Just hp) lastentered _ _) us + | lastentered /= lastAcceptedEntered us = False | loggedHash lastact == Just hp = True | B.null (val (echoData a)) = False -- optimisation | any (== Just hp) (map loggedHash bl) = |