git.iko.soy/streamly
on master help sign in
Add array boundary checks during serialization
31a679aHarendra Kumar
core/src/Streamly/Internal/Data/Serialize.hs+32−6
compare with master
unifiedsplit
@@ -20,6 +20,11 @@ module Streamly.Internal.Data.Serialize
20
20
21#include "assert.hs"
21#include "assert.hs"
22
22
23+#ifdef DEBUG
24+import Control.Exception (assert)
25+import Streamly.Internal.Data.Unbox (Unbox(..), sizeOfMutableByteArray)
26+#endif
27+
23import Control.Monad (void)
28import Control.Monad (void)
24import Data.List (foldl')
29import Data.List (foldl')
25import Data.Proxy (Proxy (..))
30import Data.Proxy (Proxy (..))
@@ -105,20 +110,41 @@ class Serialize a where
105-- Instances
110-- Instances
106--------------------------------------------------------------------------------
111--------------------------------------------------------------------------------
107
112
113+{-# INLINE checkBounds #-}
114+checkBounds :: String -> Int -> MutableByteArray -> IO ()
115+checkBounds _label _off _arr = do
116+#ifdef DEBUG
117+ sz <- sizeOfMutableByteArray _arr
118+ if (_off > sz)
119+ then error
120+ $ _label
121+ ++ ": accessing array at offset = "
122+ ++ show (_off - 1)
123+ ++ " max valid offset = " ++ show (sz - 1)
124+ else return ()
125+#else
126+ return ()
127+#endif
128+
108#define DERIVE_SERIALIZE_FROM_UNBOX(_type) \
129#define DERIVE_SERIALIZE_FROM_UNBOX(_type) \
109instance Serialize _type where \
130instance Serialize _type where \
110; {-# INLINE size #-} \
131; {-# INLINE size #-} \
111; size = Size (\acc _ -> acc + Unbox.sizeOf (Proxy :: Proxy _type)) \
132; size = Size (\acc _ -> acc + Unbox.sizeOf (Proxy :: Proxy _type)) \
112; {-# INLINE deserialize #-} \
133; {-# INLINE deserialize #-} \
113; deserialize off arr = \
134; deserialize off arr = \
114− Unbox.peekByteIndex off arr >>= \
115− \val -> let sz = Unbox.sizeOf (Proxy :: Proxy _type) \
135+ let next = off + Unbox.sizeOf (Proxy :: Proxy _type) \
116− in pure (off + sz, val) \
136+ in do { \
137+ checkBounds "deserialize" next arr; \
138+ Unbox.peekByteIndex off arr >>= \val -> pure (next, val); \
139+ } \
117; {-# INLINE serialize #-} \
140; {-# INLINE serialize #-} \
118; serialize off arr val = \
141; serialize off arr val = \
119− Unbox.pokeByteIndex off arr val \
120− >> let sz = Unbox.sizeOf (Proxy :: Proxy _type) \
142+ let next = off + Unbox.sizeOf (Proxy :: Proxy _type) \
143+ in do { \
144+ checkBounds "serialize" next arr; \
145+ Unbox.pokeByteIndex off arr val; \
121− in pure (off + sz)
146+ pure next \
147+ }
122
148
123DERIVE_SERIALIZE_FROM_UNBOX(Bool)
149DERIVE_SERIALIZE_FROM_UNBOX(Bool)
124DERIVE_SERIALIZE_FROM_UNBOX(Char)
150DERIVE_SERIALIZE_FROM_UNBOX(Char)
core/src/Streamly/Internal/Data/Unbox.hs+1−2
@@ -17,6 +17,7 @@ module Streamly.Internal.Data.Unbox
17 , MutableByteArray(..)
17 , MutableByteArray(..)
18 , touch
18 , touch
19 , getMutableByteArray#
19 , getMutableByteArray#
20+ , sizeOfMutableByteArray
20 , isPinned
21 , isPinned
21 , pin
22 , pin
22 , unpin
23 , unpin
@@ -100,7 +101,6 @@ touch :: MutableByteArray -> IO ()
100touch (MutableByteArray contents) =
101touch (MutableByteArray contents) =
101 IO $ \s -> case touch# contents s of s' -> (# s', () #)
102 IO $ \s -> case touch# contents s of s' -> (# s', () #)
102
103
103−{-
104-- | Return the size of the array in bytes.
104-- | Return the size of the array in bytes.
105{-# INLINE sizeOfMutableByteArray #-}
105{-# INLINE sizeOfMutableByteArray #-}
106sizeOfMutableByteArray :: MutableByteArray -> IO Int
106sizeOfMutableByteArray :: MutableByteArray -> IO Int
@@ -108,7 +108,6 @@ sizeOfMutableByteArray (MutableByteArray arr) =
108 IO $ \s ->
108 IO $ \s ->
109 case getSizeofMutableByteArray# arr s of
109 case getSizeofMutableByteArray# arr s of
110 (# s1, i #) -> (# s1, I# i #)
110 (# s1, i #) -> (# s1, I# i #)
111−-}
112
111
113--------------------------------------------------------------------------------
112--------------------------------------------------------------------------------
114-- Creation
113-- Creation