Fix off-by-one bug in string null termination (#166)

Backport withCString fix and use text version when available
This commit is contained in:
romes 2022-12-12 15:20:39 +00:00 committed by GitHub
parent 52142bbf7e
commit 68e30d98ad
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23

View File

@ -26,28 +26,33 @@ import Data.Text.Foreign (withCStringLen)
-- unliftio-core -- unliftio-core
import UnliftIO (MonadUnliftIO, UnliftIO(..), withUnliftIO) import UnliftIO (MonadUnliftIO, UnliftIO(..), withUnliftIO)
#if MIN_VERSION_text(2,0,0) #if MIN_VERSION_text(2,0,1)
-- XXX: just wrap the provided combinator
import qualified Data.Text.Foreign as Text
withCString :: MonadUnliftIO m => Text -> (CString -> m a) -> m a
withCString text action =
withUnliftIO $ \(UnliftIO unlift) ->
Text.withCString text (unlift action)
#elif MIN_VERSION_text(2,0,0)
-- XXX: the text is UTF-8, alas no withCString is available
import Data.Text.Foreign (lengthWord8, unsafeCopyToPtr) import Data.Text.Foreign (lengthWord8, unsafeCopyToPtr)
import Data.Word (Word8) import Data.Word (Word8)
import Foreign (castPtr, free, mallocBytes, pokeByteOff) import Foreign (allocaBytes, castPtr, pokeByteOff)
import UnliftIO.Exception (bracket)
withCString :: MonadUnliftIO m => Text -> (CString -> m a) -> m a withCString :: MonadUnliftIO m => Text -> (CString -> m a) -> m a
withCString t = bracket create destroy withCString t@(Text _arr _off len) action =
where withUnliftIO $ \(UnliftIO unlift) ->
size0 = lengthWord8 t + 1 allocaBytes (len + 1) $ \buf -> do
unsafeCopyToPtr t buf
create = liftIO $ do pokeByteOff buf len (0 :: Word8)
ptr <- mallocBytes size0 unlift $ action (castPtr buf)
unsafeCopyToPtr t (castPtr ptr)
pokeByteOff ptr size0 (0 :: Word8)
pure ptr
destroy ptr =
liftIO $ free ptr
#else #else
-- XXX: the text is UTF-16, let GHC do it
withCString :: MonadUnliftIO m => Text -> (CString -> m a) -> m a withCString :: MonadUnliftIO m => Text -> (CString -> m a) -> m a
withCString t action = do withCString t action = do