fix: timeout on nodes quitting (zombies)
authorMax Voit <max.voit+gtdv@with-eyes.net>
Wed, 12 Aug 2015 08:55:34 +0000 (10:55 +0200)
committerMax Voit <max.voit+gtdv@with-eyes.net>
Wed, 12 Aug 2015 08:55:34 +0000 (10:55 +0200)
src/Data/Acid/Centered/Common.hs
src/Data/Acid/Centered/Master.hs

index adcd884..19ab9d2 100644 (file)
@@ -16,6 +16,7 @@ module Data.Acid.Centered.Common
       debug
     , whenM
     , waitPoll
+    , waitPollN
     , crcOfState
     , Crc
     , NodeRevision
@@ -169,6 +170,12 @@ crcOfState state = do
 waitPoll :: Int -> IO Bool -> IO ()
 waitPoll t p = p >>= \e -> unless e $ threadDelay t >> waitPoll t p
 
+-- | By polling, wait until predicate fulfilled. Poll at max. n times.
+waitPollN :: Int -> Int -> IO Bool -> IO ()
+waitPollN t n p
+    | n == 0    = return ()
+    | otherwise = p >>= \e -> unless e $ threadDelay t >> waitPollN t (n-1) p
+
 -- | Monadic when
 whenM :: Monad m => m Bool -> m () -> m ()
 whenM b a = b >>= flip when a
index 022dee9..f74bc27 100644 (file)
@@ -337,11 +337,10 @@ closeMasterState MasterState{..} = do
         -- disallow requests
         putMVar masterStateLock ()
         -- send nodes quit
-        debug "Nodes to quitting."
+        debug "Nodes quitting."
         withMVar nodeStatus $ mapM_ (sendToSlave zmqSocket MasterQuit) . M.keys
         -- wait all nodes done
-        waitPoll 100 (withMVar nodeStatus (return . M.null))
-        -- todo: this could use a timeout, there may be zombies
+        waitPollN 100 1000 (withMVar nodeStatus (return . M.null))
         -- wait replication chan
         debug "Waiting for repChans to empty."
         writeChan masterReplicationChan RIEnd