1 files changed, 14 insertions, 2 deletions

diff --git a/Presence/Server.hs b/Presence/Server.hs
index 1141f0b0..331829e7 100644
--- a/Presence/Server.hs
+++ b/Presence/Server.hs
@@ -241,7 +241,10 @@ server = do
     mapM_ killListener   (Map.elems listening)
     let stopRetry (v,d) = do atomically $ writeTVar v False
                              interruptDelay d
-    retriers <- atomically . readTVar $ retrymap server
+    retriers <- atomically $ do
+        rmap <- readTVar $ retrymap server
+        writeTVar (retrymap server) Map.empty
+        return rmap
     mapM_ stopRetry (Map.elems retriers)
     cons <- atomically . readTVar $ conmap server
     atomically $ mapM_ (connClose . snd) (Map.elems cons)
@@ -289,7 +292,16 @@ server = do
       $ Map.lookup con map
 
   doit server (Connect addr params) = liftIO $ do
-    void . forkIO $ do
+    mb <- atomically $ do
+        rmap <- readTVar (retrymap server)
+        return $ Map.lookup addr rmap
+    maybe forkit
+          (\(v,d) -> do b <- atomically $ readTVar v
+                        interruptDelay d
+                        when (not b) forkit)
+          mb
+    where 
+    forkit = void . forkIO $ do
         proto <- getProtocolNumber "tcp"
         sock <- bracketOnError
             (socket (socketFamily addr) Stream proto)