From db64180896b395283f443d66a308048c605b217d Mon Sep 17 00:00:00 2001 From: Reid Barton Date: Tue, 1 Jul 2014 10:20:31 -0400 Subject: Check for integer overflow in allocate() (#9172) Summary: Check for integer overflow in allocate() (#9172) Test Plan: validate Reviewers: austin Reviewed By: austin Subscribers: simonmar, relrod, carter Differential Revision: https://phabricator.haskell.org/D36 --- rts/sm/Storage.c | 10 +++++++++- testsuite/.gitignore | 3 +++ testsuite/tests/rts/all.T | 5 +++++ testsuite/tests/rts/overflow1.hs | 11 +++++++++++ testsuite/tests/rts/overflow1.stderr | 1 + testsuite/tests/rts/overflow2.hs | 20 ++++++++++++++++++++ testsuite/tests/rts/overflow2.stderr | 1 + testsuite/tests/rts/overflow3.hs | 20 ++++++++++++++++++++ testsuite/tests/rts/overflow3.stderr | 1 + 9 files changed, 71 insertions(+), 1 deletion(-) create mode 100644 testsuite/tests/rts/overflow1.hs create mode 100644 testsuite/tests/rts/overflow1.stderr create mode 100644 testsuite/tests/rts/overflow2.hs create mode 100644 testsuite/tests/rts/overflow2.stderr create mode 100644 testsuite/tests/rts/overflow3.hs create mode 100644 testsuite/tests/rts/overflow3.stderr diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c index 86bd1c2bb3..d002fece9c 100644 --- a/rts/sm/Storage.c +++ b/rts/sm/Storage.c @@ -686,7 +686,15 @@ StgPtr allocate (Capability *cap, W_ n) CCS_ALLOC(cap->r.rCCCS,n); if (n >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) { - W_ req_blocks = (W_)BLOCK_ROUND_UP(n*sizeof(W_)) / BLOCK_SIZE; + // The largest number of bytes such that + // the computation of req_blocks will not overflow. + W_ max_bytes = (HS_WORD_MAX & ~(BLOCK_SIZE-1)) / sizeof(W_); + W_ req_blocks; + + if (n > max_bytes) + req_blocks = HS_WORD_MAX; // signal overflow below + else + req_blocks = (W_)BLOCK_ROUND_UP(n*sizeof(W_)) / BLOCK_SIZE; // Attempting to allocate an object larger than maxHeapSize // should definitely be disallowed. (bug #1791) diff --git a/testsuite/.gitignore b/testsuite/.gitignore index f28edefbdd..376318d1ae 100644 --- a/testsuite/.gitignore +++ b/testsuite/.gitignore @@ -1293,6 +1293,9 @@ mk/ghcconfig_*_inplace_bin_ghc-stage2.exe.mk /tests/rts/linker_unload /tests/rts/outofmem /tests/rts/outofmem2 +/tests/rts/overflow1 +/tests/rts/overflow2 +/tests/rts/overflow3 /tests/rts/prep.out /tests/rts/return_mem_to_os /tests/rts/rtsflags001 diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T index a56a3f39f0..d7c74c5847 100644 --- a/testsuite/tests/rts/all.T +++ b/testsuite/tests/rts/all.T @@ -230,3 +230,8 @@ test('T9045', [ omit_ways(['ghci']), extra_run_opts('10000 +RTS -A8k -RTS') ], c # I couldn't reproduce 9078 with the -threaded runtime, but could easily # with the non-threaded one. test('T9078', [ omit_ways(threaded_ways) ], compile_and_run, ['-with-rtsopts="-DS" -debug']) + +# 251 = RTS exit code for "out of memory" +test('overflow1', [ exit_code(251) ], compile_and_run, ['']) +test('overflow2', [ exit_code(251) ], compile_and_run, ['']) +test('overflow3', [ exit_code(251) ], compile_and_run, ['']) diff --git a/testsuite/tests/rts/overflow1.hs b/testsuite/tests/rts/overflow1.hs new file mode 100644 index 0000000000..63ed5a4e02 --- /dev/null +++ b/testsuite/tests/rts/overflow1.hs @@ -0,0 +1,11 @@ +module Main where + +import Data.Array.IO +import Data.Word + +-- Try to overflow BLOCK_ROUND_UP in the computation of req_blocks in allocate() +-- Here we invoke allocate() via newByteArray# and the array package. +-- Request a number of bytes close to HS_WORD_MAX, +-- subtracting a few words for overhead in newByteArray#. +-- Allocate Word32s (rather than Word8s) to get around bounds-checking in array. +main = newArray (0,maxBound `div` 4 - 10) 0 :: IO (IOUArray Word Word32) diff --git a/testsuite/tests/rts/overflow1.stderr b/testsuite/tests/rts/overflow1.stderr new file mode 100644 index 0000000000..734ca954ca --- /dev/null +++ b/testsuite/tests/rts/overflow1.stderr @@ -0,0 +1 @@ +overflow1: out of memory diff --git a/testsuite/tests/rts/overflow2.hs b/testsuite/tests/rts/overflow2.hs new file mode 100644 index 0000000000..ac72158f45 --- /dev/null +++ b/testsuite/tests/rts/overflow2.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +module Main where + +import Foreign + +-- Test allocate(), the easy way. +data Cap = Cap +foreign import ccall "rts_unsafeGetMyCapability" myCapability :: IO (Ptr Cap) +foreign import ccall "allocate" allocate :: Ptr Cap -> Word -> IO (Ptr ()) + +-- Number of words n such that n * sizeof(W_) exactly overflows a word +-- (2^30 on a 32-bit system, 2^61 on a 64-bit system) +overflowWordCount :: Word +overflowWordCount = fromInteger $ + (fromIntegral (maxBound :: Word) + 1) `div` + fromIntegral (sizeOf (undefined :: Word)) + +main = do + cap <- myCapability + allocate cap (overflowWordCount - 1) diff --git a/testsuite/tests/rts/overflow2.stderr b/testsuite/tests/rts/overflow2.stderr new file mode 100644 index 0000000000..be65509ea9 --- /dev/null +++ b/testsuite/tests/rts/overflow2.stderr @@ -0,0 +1 @@ +overflow2: out of memory diff --git a/testsuite/tests/rts/overflow3.hs b/testsuite/tests/rts/overflow3.hs new file mode 100644 index 0000000000..31dfd5db53 --- /dev/null +++ b/testsuite/tests/rts/overflow3.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +module Main where + +import Foreign + +-- Test allocate(), the easy way. +data Cap = Cap +foreign import ccall "rts_unsafeGetMyCapability" myCapability :: IO (Ptr Cap) +foreign import ccall "allocate" allocate :: Ptr Cap -> Word -> IO (Ptr ()) + +-- Number of words n such that n * sizeof(W_) exactly overflows a word +-- (2^30 on a 32-bit system, 2^61 on a 64-bit system) +overflowWordCount :: Word +overflowWordCount = fromInteger $ + (fromIntegral (maxBound :: Word) + 1) `div` + fromIntegral (sizeOf (undefined :: Word)) + +main = do + cap <- myCapability + allocate cap (overflowWordCount + 1) diff --git a/testsuite/tests/rts/overflow3.stderr b/testsuite/tests/rts/overflow3.stderr new file mode 100644 index 0000000000..6c804e5048 --- /dev/null +++ b/testsuite/tests/rts/overflow3.stderr @@ -0,0 +1 @@ +overflow3: out of memory -- cgit v1.2.1