summaryrefslogtreecommitdiffhomepage
path: root/Server.hs
diff options
context:
space:
mode:
authorJoey Hess <joeyh@joeyh.name>2017-04-30 13:54:02 -0400
committerJoey Hess <joeyh@joeyh.name>2017-04-30 13:54:02 -0400
commitb47e621749257331788e82e44d1565cf4d32d04b (patch)
treed6c3445be85b05fc58675552fc1bfb4f0ceb375d /Server.hs
parent89d4e18cdb6ed1c3e7916dd66cf907bedf58a549 (diff)
downloaddebug-me-b47e621749257331788e82e44d1565cf4d32d04b.tar.gz
fix probable race in use of restoreHashes
I think there was a race where a SessionKey message had been drained from the TChan, but not yet added to the developer state, which was resonsible for recent instability at startup. It manifested as protocol errors where the prevActivity hash was wrongly Nothing. Fixed by adding a MissingHashes type to tag things whose hashes have been stripped, and adding back the hashes when needed, which always happens inside atomically blocks, so won't have such a race.
Diffstat (limited to 'Server.hs')
-rw-r--r--Server.hs5
1 files changed, 2 insertions, 3 deletions
diff --git a/Server.hs b/Server.hs
index b9f46dd..deafe41 100644
--- a/Server.hs
+++ b/Server.hs
@@ -7,7 +7,6 @@ import CmdLine
import WebSockets
import SessionID
import Log
-import PrevActivity
import Network.Wai
import Network.Wai.Handler.Warp
@@ -145,7 +144,7 @@ user o ssv conn = withSessionID (serverDirectory o) $ \(loghv, sid) -> do
-- (The user is allowed to send Developer messages too.. perhaps
-- they got them from a developer connected to them some other
-- way.)
- relayfromuser mytid session = relayFromSocket conn noRecentActivity (return ()) $ \msg -> do
+ relayfromuser mytid session = relayFromSocket conn $ \msg -> do
l <- mkLog msg <$> getPOSIXTime
writeSession mytid session l
@@ -184,7 +183,7 @@ developer o ssv sid conn = bracket setup cleanup go
-- Relay all Developer amessages from the developer's websocket
-- to the broadcast channel.
- relayfromdeveloper mytid session = relayFromSocket conn noRecentActivity (return ())
+ relayfromdeveloper mytid session = relayFromSocket conn
$ \msg -> case msg of
Developer _ -> do
l <- mkLog msg <$> getPOSIXTime