git.iko.soy/typeable/yaml
on master help sign in
Fixed segfault in makeString: peekCString may be invoked with nullPtr (i.e.
9e64c3eAnton Ageev
Text/Libyaml.hs+3−1
compare with master
unifiedsplit
@@ -258,7 +258,9 @@ foreign import ccall unsafe "get_parser_error_offset"
258makeString :: MonadIO m => (a -> m (Ptr CUChar)) -> a -> m String
258makeString :: MonadIO m => (a -> m (Ptr CUChar)) -> a -> m String
259makeString f a = do
259makeString f a = do
260 cchar <- castPtr `liftM` f a
260 cchar <- castPtr `liftM` f a
261+ if cchar == nullPtr
262+ then return ""
261− liftIO $ peekCString cchar
263+ else liftIO $ peekCString cchar
262
264
263parserParseOne :: (MonadFailure YamlException m, With m)
265parserParseOne :: (MonadFailure YamlException m, With m)
264 => Parser
266 => Parser
runtests.hs+17
@@ -16,6 +16,8 @@ import Test.Framework.Providers.HUnit
16import Test.HUnit hiding (Test, path)
16import Test.HUnit hiding (Test, path)
17--import Test.QuickCheck
17--import Test.QuickCheck
18
18
19+import Control.Exception
20+
19main :: IO ()
21main :: IO ()
20main = defaultMain
22main = defaultMain
21 [ testCase "count scalars with anchor" caseCountScalarsWithAnchor
23 [ testCase "count scalars with anchor" caseCountScalarsWithAnchor
@@ -27,6 +29,7 @@ main = defaultMain
27 , testCase "encode/decode" caseEncodeDecode
29 , testCase "encode/decode" caseEncodeDecode
28 , testCase "encode/decode file" caseEncodeDecodeFile
30 , testCase "encode/decode file" caseEncodeDecodeFile
29 , testCase "interleaved encode/decode" caseInterleave
31 , testCase "interleaved encode/decode" caseInterleave
32+ , testCase "decode invalid document (without segfault)" caseDecodeInvalidDocument
30 ]
33 ]
31
34
32caseCountScalarsWithAnchor :: Assertion
35caseCountScalarsWithAnchor :: Assertion
@@ -173,3 +176,17 @@ caseInterleave = do
173 case e of
176 case e of
174 EventNone -> return ()
177 EventNone -> return ()
175 _ -> emitEvent e >> inside
178 _ -> emitEvent e >> inside
179+
180+caseDecodeInvalidDocument :: Assertion
181+caseDecodeInvalidDocument = do
182+ handle (\(YamlParserException {}) -> return ()) $ do
183+ _ <- decode yamlBS $ dec id
184+ assertFailure "expected parsing exception, but got no errors"
185+ where
186+ yamlString = " - foo\n - baz\nbuz"
187+ yamlBS = B8.pack yamlString
188+ dec front = do
189+ e <- parseEvent
190+ case e of
191+ EventNone -> return $ front []
192+ _ -> dec $ front . (:) e