diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,9 @@ # bz2 +## 1.0.0.3 + + * Fix bug decompressing partial data + ## 1.0.0.2 * Change buffering parameters for speed diff --git a/Makefile b/Makefile --- a/Makefile +++ b/Makefile @@ -1,6 +1,5 @@ .PHONY: clean -SHELL := bash MAKEFLAGS += --warn-undefined-variables --no-builtin-rules .DELETE_ON_ERROR: @@ -13,4 +12,4 @@ wget https://sourceware.org/pub/valgrind/valgrind-3.15.0.tar.bz2 -O $@ valgrind-3.15.0.tar: valgrind-3.15.0.tar.bz2 - bzip2 -d $< --keep + bzip2 -d $^ --keep diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,16 +1,20 @@ # bz2 -High-level bindings to [bzip2](https://www.sourceware.org/bzip2/). +High-level bindings to [bzip2](https://www.sourceware.org/bzip2/). ## Comparison Compared to [bzlib](http://hackage.haskell.org/package/bzlib): * Bundles `bzip2` 1.0.8. - * Compatible with GHC 8.8.2 + * Compatible with GHC 8.8+ * Uses [c2hs](https://github.com/haskell/c2hs) rather than [hsc2hs](https://hackage.haskell.org/package/hsc2hs) and thus has a larger dependency footprint + +Unlike [pipes-bzip](http://hackage.haskell.org/package/pipes-bzip) and +[bzlib-conduit](http://hackage.haskell.org/package/bzlib-conduit), bz2 can be +cross-compiled. ## Backpack Integration diff --git a/bench/BZip/Dump.hs b/bench/BZip/Dump.hs new file mode 100644 --- /dev/null +++ b/bench/BZip/Dump.hs @@ -0,0 +1,28 @@ +module BZip.Dump ( compressDump + , decompressDump + , decompressForce + ) where + +import Control.Applicative +import qualified Data.ByteString.Lazy as BSL +import System.FilePath (()) +import System.IO.Temp (withSystemTempDirectory) + +decompressForce :: (BSL.ByteString -> BSL.ByteString) -> IO () +decompressForce go = + forceBSL =<< + (go <$> BSL.readFile "valgrind-3.15.0.tar.bz2") + + where forceBSL = (`seq` pure ()) . last . BSL.toChunks + +{-# INLINE decompressDump #-} +decompressDump :: (BSL.ByteString -> BSL.ByteString) -> IO () +decompressDump go = withSystemTempDirectory "bz2" $ + \fp -> BSL.writeFile (fp "valgrind-3.15.0.tar") =<< + (go <$> BSL.readFile "valgrind-3.15.0.tar.bz2") + +{-# INLINE compressDump #-} +compressDump :: (BSL.ByteString -> BSL.ByteString) -> IO () +compressDump go = withSystemTempDirectory "bz2" $ + \fp -> BSL.writeFile (fp "valgrind-3.15.0.tar.bz2") =<< + (go <$> BSL.readFile "valgrind-3.15.0.tar") diff --git a/bench/Bench.cpphs b/bench/Bench.cpphs --- a/bench/Bench.cpphs +++ b/bench/Bench.cpphs @@ -2,45 +2,14 @@ module Main (main) where --- TODO: bench bzlib? +import BZip.Dump import qualified "bz2" Codec.Compression.BZip as BZ2 #ifdef WITH_BZLIB import qualified "bzlib" Codec.Compression.BZip as BZlib #endif -import Conduit (runResourceT) import Criterion.Main import qualified Data.ByteString.Lazy as BSL -import Data.Conduit (runConduit, (.|)) -import qualified Data.Conduit.BZlib as C -import Data.Conduit.Combinators (sinkFile, sourceFile) -import Pipes (runEffect, (>->)) -import qualified Pipes.ByteString as P -import qualified Pipes.BZip as P -import Pipes.Safe (runSafeT) -import System.FilePath (()) -import System.IO (IOMode (ReadMode, WriteMode), withFile) -import System.IO.Temp (withSystemTempDirectory) -decompressDump :: (BSL.ByteString -> BSL.ByteString) -> IO () -decompressDump go = withSystemTempDirectory "bz2" $ - \fp -> BSL.writeFile (fp "valgrind-3.15.0.tar") =<< - (go <$> BSL.readFile "valgrind-3.15.0.tar.bz2") - -compressDump :: (BSL.ByteString -> BSL.ByteString) -> IO () -compressDump go = withSystemTempDirectory "bz2" $ - \fp -> BSL.writeFile (fp "valgrind-3.15.0.tar.bz2") =<< - (go <$> BSL.readFile "valgrind-3.15.0.tar") - -decompressDumpPipes :: IO () -decompressDumpPipes = withSystemTempDirectory "bz2" $ \fp -> - withFile "valgrind-3.15.0.tar.bz2" ReadMode $ \hIn -> - withFile (fp "valgrind-3.15.0.tar") WriteMode $ \hOut -> - runSafeT $ runEffect $ P.bunzip2 (P.fromHandle hIn) >-> P.toHandle hOut - -decompressDumpConduit :: IO () -decompressDumpConduit = withSystemTempDirectory "bz2" $ \fp -> - runResourceT $ runConduit $ sourceFile "valgrind-3.15.0.tar.bz2" .| C.bunzip2 .| sinkFile (fp "valgrind-3.15.0.tar") - decompressFile :: FilePath -> IO BSL.ByteString decompressFile = fmap BZ2.decompress . BSL.readFile @@ -54,8 +23,6 @@ #ifdef WITH_BZLIB , bench "decompress + write to file (bzlib)" $ nfIO (decompressDump BZlib.decompress) #endif - , bench "decompress + write to file (pipes-bzip)" $ nfIO decompressDumpPipes - , bench "decompress + write to file (bzlib-conduit)" $ nfIO decompressDumpConduit ] , bgroup "compressDump" [ bench "compress + write to file (bz2)" $ nfIO (compressDump BZ2.compress) diff --git a/bz2.cabal b/bz2.cabal --- a/bz2.cabal +++ b/bz2.cabal @@ -1,6 +1,6 @@ -cabal-version: 1.18 +cabal-version: 2.0 name: bz2 -version: 1.0.0.2 +version: 1.0.0.3 license: BSD3 license-file: LICENSE copyright: Copyright: (c) 2020 Vanessa McHale @@ -81,6 +81,9 @@ if impl(ghc >=8.4) ghc-options: -Wmissing-export-lists + if impl(ghc >=8.10) + ghc-options: -Wunused-packages + test-suite bz2-test type: exitcode-stdio-1.0 main-is: Spec.hs @@ -96,7 +99,8 @@ tasty-golden -any, tasty-hunit -any, deepseq -any, - directory -any + directory -any, + mmap -any if impl(ghc >=8.0) ghc-options: @@ -109,11 +113,15 @@ if impl(ghc >=8.2) ghc-options: -Wcpp-undef + if impl(ghc >=8.10) + ghc-options: -Wunused-packages + benchmark bz2-bench type: exitcode-stdio-1.0 main-is: Bench.hs build-tool-depends: cpphs:cpphs -any hs-source-dirs: bench + other-modules: BZip.Dump default-language: Haskell2010 other-extensions: PackageImports ghc-options: -threaded -rtsopts -with-rtsopts=-N -O3 -Wall @@ -121,14 +129,8 @@ base -any, bz2 -any, criterion -any, - filepath -any, temporary -any, - pipes-bzip, - pipes-bytestring, - pipes, - pipes-safe, - bzlib-conduit, - conduit >=1.3.0, + filepath -any, bytestring -any if flag(with-bzlib) @@ -148,18 +150,5 @@ if impl(ghc >=8.2) ghc-options: -Wcpp-undef -benchmark bz2-mem - type: exitcode-stdio-1.0 - main-is: Mem.hs - hs-source-dirs: mem - default-language: Haskell2010 - ghc-options: -Wall - build-depends: - base -any, - bz2 -any, - filepath -any, - temporary -any, - bytestring -any - - if impl(ghc >=8.0) - ghc-options: -Wincomplete-uni-patterns -Wincomplete-record-updates + if impl(ghc >=8.10) + ghc-options: -Wunused-packages diff --git a/mem/Mem.hs b/mem/Mem.hs deleted file mode 100644 --- a/mem/Mem.hs +++ /dev/null @@ -1,21 +0,0 @@ -module Main (main) where - -import Codec.Compression.BZip (compress, decompress) -import qualified Data.ByteString.Lazy as BSL -import System.FilePath (()) -import System.IO.Temp (withSystemTempDirectory) - -main :: IO () -main = - compressDump *> - decompressDump - -decompressDump :: IO () -decompressDump = withSystemTempDirectory "bz2" $ - \fp -> BSL.writeFile (fp "valgrind-3.15.0.tar") =<< - (decompress <$> BSL.readFile "valgrind-3.15.0.tar.bz2") - -compressDump :: IO () -compressDump = withSystemTempDirectory "bz2" $ - \fp -> BSL.writeFile (fp "valgrind-3.15.0.tar.bz2") =<< - (compress <$> BSL.readFile "valgrind-3.15.0.tar") diff --git a/src/Codec/Compression/BZip/Unpack.chs b/src/Codec/Compression/BZip/Unpack.chs --- a/src/Codec/Compression/BZip/Unpack.chs +++ b/src/Codec/Compression/BZip/Unpack.chs @@ -7,11 +7,13 @@ import Codec.Compression.BZip.Foreign.Decompress import Codec.Compression.BZip.Common import Control.Applicative +import Control.Monad (when) import Control.Monad.ST.Lazy as LazyST import Control.Monad.ST.Lazy.Unsafe as LazyST import qualified Data.ByteString as BS import qualified Data.ByteString.Unsafe as BS import qualified Data.ByteString.Lazy as BSL +import Data.Maybe (isNothing) import Foreign.ForeignPtr (newForeignPtr, castForeignPtr, ForeignPtr, mallocForeignPtrBytes, withForeignPtr) import Foreign.Ptr (Ptr, castPtr, nullPtr) @@ -19,6 +21,8 @@ -- | Don't use this on pathological input; it may not be secure -- +-- This does not handle nested streams +-- -- @since 0.1.1.0 decompress :: BSL.ByteString -> BSL.ByteString decompress bsl = @@ -73,7 +77,9 @@ if ret == BzStreamEnd then pure (newBSAp []) - else newBSAp <$> fillBuf pForeign keepAlive bs'' step' bufOutForeign + else if null bs' && isNothing keepAlive && bufSz == szOut + then error "Out of input" + else newBSAp <$> fillBuf pForeign keepAlive bs'' step' bufOutForeign keepBytesAlive :: Ptr BzStream -> Maybe BS.ByteString -> [BS.ByteString] -> IO BZError -> IO (BZError, Maybe BS.ByteString, [BS.ByteString]) keepBytesAlive _ Nothing bs' act = (, Nothing, bs') <$> act diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,10 +1,12 @@ module Main (main) where import Codec.Compression.BZip +import Control.Concurrent (forkIO, newEmptyMVar, putMVar, readMVar) import Control.DeepSeq (deepseq) import qualified Data.ByteString.Lazy as BSL import System.Directory (doesFileExist) import System.FilePath ((-<.>)) +import System.IO.MMap (mmapFileByteStringLazy) import Test.Tasty import Test.Tasty.Golden import Test.Tasty.HUnit @@ -13,6 +15,17 @@ testDecompress fp = goldenVsString ("Decompress " ++ fp) (fp -<.> ".ref") (decompress <$> BSL.readFile fp) +forceHead :: BSL.ByteString -> IO () +forceHead bsl = head (BSL.toChunks bsl) `seq` (pure ()) + +forceBSL :: BSL.ByteString -> IO () +forceBSL bsl = last (BSL.toChunks bsl) `seq` (pure ()) + +testDecompressMMap :: FilePath -> TestTree +testDecompressMMap fp = testCase ("Decompress mmap " ++ fp) $ do + res <- decompress <$> mmapFileByteStringLazy fp Nothing + assertBool "Doesn't crash" (last (BSL.toChunks res) `seq` True) + testCompress :: FilePath -> TestTree testCompress fp = testCase ("Roundtrip " ++ fp) $ do contents <- BSL.readFile fp @@ -28,9 +41,22 @@ testValgrindPack :: TestTree testValgrindPack = testCase "Pack valgrind" $ do contents <- BSL.readFile "valgrind-3.15.0.tar" - let actual = compress contents + -- let actual = compress contents + let preRes = compress contents + forceHead preRes + res <- newEmptyMVar + _ <- forkIO (forceBSL preRes) + _ <- forkIO (forceBSL preRes *> putMVar res preRes) + actual <- readMVar res assertBool "Packs w/o error" (actual `deepseq` True) +-- if decompressing invalid data, bail out +testNoLoop :: TestTree +testNoLoop = testCase "Decompress partial" $ do + contents <- BSL.readFile "test/data/sample2.bz2" + let partial = BSL.take (64 * 1024) contents + forceBSL (decompress partial) *> assertFailure "Throws exception" + main :: IO () main = do valgrind <- (&&) <$> doesFileExist "valgrind-3.15.0.tar.bz2" <*> doesFileExist "valgrind-3.15.0.tar" @@ -40,16 +66,19 @@ else id defaultMain $ - testGroup "bz2" (go [testDecompression, testCompression]) + testGroup "bz2" (go [testDecompression, testCompression, testMMap]) where + compressedFiles = [ "test/data/sample1.bz2" + , "test/data/sample2.bz2" + , "test/data/sample3.bz2" + ] testDecompression = testGroup "Decompress" - [ testDecompress "test/data/sample1.bz2" - , testDecompress "test/data/sample2.bz2" - , testDecompress "test/data/sample3.bz2" - ] + (testDecompress <$> compressedFiles) testCompression = testGroup "Compress" [ testCompress "test/data/sample1.ref" , testCompress "test/data/sample2.ref" , testCompress "test/data/sample3.ref" ] + testMMap = testGroup "MMap" + (testDecompressMMap <$> compressedFiles)