diff options
Diffstat (limited to 'Role/User.hs')
| -rw-r--r-- | Role/User.hs | 50 |
1 files changed, 33 insertions, 17 deletions
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) = |