1 files changed, 10 insertions, 4 deletions

diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs
index 50224178..8975e4dc 100644
--- a/src/Network/Tox/Crypto/Handlers.hs
+++ b/src/Network/Tox/Crypto/Handlers.hs
@@ -39,6 +39,7 @@ import SensibleDir
 import System.FilePath
 import System.Environment
 import System.Directory
+import System.Timeout
 #ifdef THREAD_DEBUG
 import Control.Concurrent.Lifted.Instrument
 #else
@@ -766,8 +767,9 @@ tryAppendQueueOutgoing getExtra outq msg = do
     mbWire <- nqToWire outq getExtra nextno be pktno msg
     case mbWire of
         Just (payload,seqno) -> do
-            PB.grokOutboundPacket (nqPacketBuffer outq) (PacketSent seqno payload)
-            return $ OGSuccess payload
+            (isFull,_) <- PB.grokOutboundPacket (nqPacketBuffer outq) (PacketSent seqno payload)
+            if isFull then return OGFull
+                      else return $ OGSuccess payload
         Nothing -> return OGEncodeFail
 
 
@@ -1253,12 +1255,16 @@ sendCrypto crypto session updateLocal cm = do
     dput XNetCrypto "sendCrypto: enter "
     getOutGoingParam <- nqToWireIO outq
     dput XNetCrypto "sendCrypto: got the io extra stuff"
-    r <- atomically $ do
+    ncTime <- atomically $ readTVar (ncTimeOut session)
+    r0 <- timeout (ncTime*1000) . atomically $ do
         result <- tryAppendQueueOutgoing getOutGoingParam outq cm
         case result of
             OGSuccess x  -> updateLocal >> return (Right x)
-            OGFull       -> return (Left "Outgoing packet buffer is full")
+            OGFull       -> retry -- return (Left "Outgoing packet buffer is full")
             OGEncodeFail -> return (Left "Failed to encode outgoing packet")
+    let r = case r0 of
+                Nothing -> Left "Outgoing packet buffer is full"
+                Just x  -> x
     case ncSockAddr session of
         HaveDHTKey saddr -> mapM_ (sendSessionPacket (ncAllSessions session) saddr) r
         _                -> return ()