Merge pull request #551 from IntersectMBO/jdral/issue-549

Fix out-of-bounds array access in `hFlipBit`.

Author: jorisdral

test/Test/FS.hs

@@ -124,16 +124,19 @@ createFile hfs p = withFile hfs p (WriteMode MustBeNew) $ \_ -> pure ()
 data WithBitOffset a = WithBitOffset Int a
   deriving stock Show
 
+bitLength :: BS.ByteString -> Int
+bitLength bs = BS.length bs * 8
+
 instance Arbitrary (WithBitOffset ByteString) where
   arbitrary = do
       bs <- arbitrary `suchThat` (\bs -> BS.length bs > 0)
-      bitOffset <- chooseInt (0, BS.length bs - 1)
+      bitOffset <- chooseInt (0, bitLength bs - 1)
       pure $ WithBitOffset bitOffset bs
   shrink (WithBitOffset bitOffset bs) =
       [ WithBitOffset bitOffset' bs'
       | bs' <- shrink bs
       , BS.length bs' > 0
-      , let bitOffset' = max 0 $ min (BS.length bs' - 1) bitOffset
+      , let bitOffset' = max 0 $ min (bitLength bs' - 1) bitOffset
       ] ++ [
         WithBitOffset bitOffset' bs
       | bitOffset' <- max 0 <$> shrink bitOffset

test/Test/Util/FS.hs

@@ -360,23 +360,31 @@ hFlipBit ::
   -> Int -- ^ Bit offset
   -> m ()
 hFlipBit hfs h bitOffset = do
+    -- Check that the bit offset is within the file
+    fileSize <- hGetSize hfs h
+    let fileSizeBits = 8 * fileSize
+    assert (bitOffset >= 0) $ pure ()
+    assert (bitOffset < fromIntegral fileSizeBits) $ pure ()
     -- Create an empty buffer initialised to all 0 bits. The buffer must have at
     -- least the size of a machine word.
     let n = sizeOf (0 :: Word)
     buf <- newPinnedByteArray n
-    setByteArray buf 0 n (0 :: Word)
+    setByteArray buf 0 1 (0 :: Word)
     -- Read the bit at the given offset
     let (byteOffset, i) = bitOffset `quotRem` 8
         bufOff = BufferOffset 0
         count = 1
         off = AbsOffset (fromIntegral byteOffset)
+    -- Check that the byte offset is within the file
+    assert (byteOffset >= 0) $ pure ()
+    assert (byteOffset < fromIntegral fileSize) $ pure ()
+    assert (i >= 0 && i < 8) $ pure ()
     void $ hGetBufExactlyAt hfs h buf bufOff count off
     -- Flip the bit in memory, and then write it back
     let bvec = BitMVec 0 8 buf
     flipBit bvec i
     void $ hPutBufExactlyAt hfs h buf bufOff count off
 
-
 {-------------------------------------------------------------------------------
   Errors
 -------------------------------------------------------------------------------}