tox: Avoid corrupting outbound buffer on nonsense ack.

1 files changed, 25 insertions, 17 deletions

diff --git a/src/Data/PacketQueue.hs b/src/Data/PacketQueue.hs
index c5d5ac09..aa51426b 100644
--- a/src/Data/PacketQueue.hs
+++ b/src/Data/PacketQueue.hs
@@ -10,6 +10,7 @@ module Data.PacketQueue
     , getLastEnqueuedPlus1
     , new
     , dequeue
+    , dropPacketsLogic
     , dropPacketsBefore
     , getMissing
     -- , dequeueOrGetMissing
@@ -33,6 +34,10 @@ data PacketQueue a = PacketQueue
     , qsize   :: Word32
     , buffend :: TVar Word32 -- on incoming, next packet they'll send + 1
                              -- i.e. one more than the largest seen sequence number.
+        -- Written by:
+        --   observeOutOfBand
+        --   dropPacketsBefore
+        --   enqueue
     }
 
 -- | Obtain a list of non-empty slots in the 'PacketQueue'.  The numeric value
@@ -133,27 +138,30 @@ dequeue PacketQueue { pktq, seqno, qsize } = do
     modifyTVar' seqno   succ
     return x
 
+-- | Helper to 'dropPacketsBefore'.
+dropPacketsLogic :: Word32 -> Word32 -> Word32 -> (Maybe Word32, Word32, [(Word32,Word32)])
+dropPacketsLogic qsize low no0 =
+    let no = no0 - 1    -- Unsigned: could overflow
+        proj = no - low -- Unsigned: could overflow
+    in if proj < qsize
+        then
+            let ilow = low  `mod` qsize
+                i = no `mod` qsize
+                ranges = if ilow <= i then [(ilow, i)]
+                                      else [(0,i),(ilow,qsize-1)]
+            in (Nothing,no0,ranges) -- Clear some, but not all, slots.
+        else (Nothing,low,[]) -- out of bounds, do nothing  -- (Just no0, no0, [(0,qsize - 1)]) -- Reset to empty queue.
+
+
 -- | Drop all packets preceding the given packet number.
 dropPacketsBefore :: PacketQueue a -> Word32 -> STM ()
 dropPacketsBefore PacketQueue{ pktq, seqno, qsize, buffend } no0 = do
     low <- readTVar seqno
-    let no = no0 - 1 -- possibly negative
-        proj = no - low -- possibly negative
-    if (proj < qsize)
-        then do
-            -- Clear some, but not all, slots.
-            let ilow = low  `mod` qsize
-                i = no `mod` qsize
-                ranges = if ilow <= i then [[ilow .. i]]
-                                      else [[0 .. i],[ilow .. qsize-1]]
-            writeTVar seqno no
-            forM_ ranges $ mapM_ $ \i -> writeArray pktq i Nothing
-        else do
-            -- Reset to empty queue.
-            writeTVar seqno no
-            writeTVar buffend no
-            (z,n) <- getBounds pktq
-            forM_ [z .. n] $ \i -> writeArray pktq i Nothing
+    let (mbuffend, no, ranges) = dropPacketsLogic qsize low no0
+    mapM_ (writeTVar buffend) mbuffend
+    writeTVar seqno no
+    forM_ ranges $ \(lo,hi) -> forM_ [lo .. hi] $ \i -> writeArray pktq i Nothing
+
 
 -- -- | Like dequeue, but marks as viewed rather than removing
 -- markButNotDequeue :: PacketQueue (Bool,a) -> STM a