lzma 0.0.0.2 → 0.0.0.3
raw patch · 3 files changed
+29/−10 lines, 3 filesdep ~HUnitdep ~QuickCheckdep ~base
Dependency ranges changed: HUnit, QuickCheck, base, bytestring, tasty, tasty-hunit, tasty-quickcheck
Files
- Changelog.md +3/−0
- lzma.cabal +5/−2
- src/Codec/Compression/Lzma.hs +21/−8
+ Changelog.md view
@@ -0,0 +1,3 @@+## 0.0.0.3++* Fix potential reentrancy issue also discovered in `zlib` ([#4](https://github.com/hvr/lzma/issues/4))
lzma.cabal view
@@ -1,5 +1,5 @@ name: lzma-version: 0.0.0.2+version: 0.0.0.3 synopsis: LZMA/XZ compression and decompression homepage: https://github.com/hvr/lzma bug-reports: https://github.com/hvr/lzma/issues@@ -12,7 +12,7 @@ category: Codec, Compression build-type: Simple cabal-version: >=1.10-tested-with: GHC ==7.4.2, GHC ==7.6.3, GHC ==7.8.4, GHC ==7.10.3, GHC ==8.0.1+tested-with: GHC ==7.4.2, GHC ==7.6.3, GHC ==7.8.4, GHC ==7.10.3, GHC ==8.0.1, GHC ==8.0.2 description: This package provides a pure interface for compressing and decompressing@@ -28,6 +28,9 @@ . * </package/pipes-lzma pipes-lzma> (for </package/pipes pipes>) .++extra-source-files:+ Changelog.md source-repository head type: git
src/Codec/Compression/Lzma.hs view
@@ -63,10 +63,13 @@ import Control.Monad import Control.Monad.ST (stToIO) import Control.Monad.ST.Lazy (ST, runST, strictToLazyST)+import qualified Control.Monad.ST.Strict as ST.Strict (ST)+import Control.Monad.ST.Unsafe (unsafeIOToST) import Data.ByteString (ByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL import qualified Data.ByteString.Lazy.Internal as BSL+import GHC.IO (noDuplicate) import LibLzma -- | Decompress lazy 'ByteString' from the @.xz@ format@@ -199,7 +202,8 @@ -- | Incremental compression in the lazy 'ST' monad. compressST :: CompressParams -> ST s (CompressStream (ST s))-compressST parms = strictToLazyST (newEncodeLzmaStream parms) >>= either throw go+compressST parms = strictToLazyST (newEncodeLzmaStream parms) >>=+ either throw go where bUFSIZ = 32752 @@ -209,7 +213,8 @@ goInput :: ByteString -> ST s (CompressStream (ST s)) goInput chunk = do- (rc, used, obuf) <- strictToLazyST $ runLzmaStream ls chunk LzmaRun bUFSIZ+ (rc, used, obuf) <- strictToLazyST (noDuplicateST >>+ runLzmaStream ls chunk LzmaRun bUFSIZ) let chunk' = BS.drop used chunk @@ -234,7 +239,8 @@ goSync action next = goSync' where goSync' = do- (rc, 0, obuf) <- strictToLazyST $ runLzmaStream ls BS.empty action bUFSIZ+ (rc, 0, obuf) <- strictToLazyST (noDuplicateST >>+ runLzmaStream ls BS.empty action bUFSIZ) case rc of LzmaRetOK | BS.null obuf -> fail ("compressIO: empty output chunk during " ++ show action)@@ -245,7 +251,7 @@ _ -> throw rc retStreamEnd = do- !() <- strictToLazyST (endLzmaStream ls)+ !() <- strictToLazyST (noDuplicateST >> endLzmaStream ls) return CompressStreamEnd --------------------------------------------------------------------------------@@ -319,7 +325,8 @@ -- | Incremental decompression in the lazy 'ST' monad. decompressST :: DecompressParams -> ST s (DecompressStream (ST s))-decompressST parms = strictToLazyST (newDecodeLzmaStream parms) >>= either (return . DecompressStreamError) go+decompressST parms = strictToLazyST (newDecodeLzmaStream parms) >>=+ either (return . DecompressStreamError) go where bUFSIZ = 32752 @@ -332,7 +339,8 @@ goInput chunk | BS.null chunk = goFinish | otherwise = do- (rc, used, obuf) <- strictToLazyST $ runLzmaStream ls chunk LzmaRun bUFSIZ+ (rc, used, obuf) <- strictToLazyST (noDuplicateST >>+ runLzmaStream ls chunk LzmaRun bUFSIZ) let chunk' = BS.drop used chunk @@ -361,7 +369,8 @@ goSync action next = goSync' where goSync' = do- (rc, 0, obuf) <- strictToLazyST $ runLzmaStream ls BS.empty action bUFSIZ+ (rc, 0, obuf) <- strictToLazyST (noDuplicateST >>+ runLzmaStream ls BS.empty action bUFSIZ) case rc of LzmaRetOK | BS.null obuf -> next@@ -376,7 +385,7 @@ eof0 = retStreamEnd BS.empty retStreamEnd chunk' = do- !() <- strictToLazyST (endLzmaStream ls)+ !() <- strictToLazyST (noDuplicateST >> endLzmaStream ls) return (DecompressStreamEnd chunk') -- | Small 'maybe'-ish helper distinguishing between empty and@@ -385,3 +394,7 @@ withChunk emptyChunk nemptyChunk chunk | BS.null chunk = emptyChunk | otherwise = nemptyChunk chunk++-- | See <https://github.com/haskell/zlib/issues/7>+noDuplicateST :: ST.Strict.ST s ()+noDuplicateST = unsafeIOToST noDuplicate