diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,7 @@ +## 0.2.3.1 - 2018-06-06 + * Fixed drops associated payload for unsupported headers ((https://github.com/snoyberg/tar-conduit/issues/17)) ([PR 18](https://github.com/snoyberg/tar-conduit/pull/18)) + * Dropped support for GHC 7/Stack LTS-2, LTS-3, LTS-6 + ## 0.2.3 - 2018-02-10 * Fixed compatibility with new `conduit >= 1.3.0` diff --git a/src/Data/Conduit/Tar.hs b/src/Data/Conduit/Tar.hs --- a/src/Data/Conduit/Tar.hs +++ b/src/Data/Conduit/Tar.hs @@ -68,10 +68,10 @@ headerFilePathBS :: Header -> S.ByteString headerFilePathBS Header {..} = - if SS.length headerFileNamePrefix > 0 - then S.concat + if SS.null headerFileNamePrefix + then fromShort headerFileNameSuffix + else S.concat [fromShort headerFileNamePrefix, pathSeparatorS, fromShort headerFileNameSuffix] - else fromShort headerFileNameSuffix -- | Construct a `FilePath` from `headerFileNamePrefix` and `headerFileNameSuffix`. -- @@ -98,7 +98,7 @@ parseHeader :: FileOffset -> ByteString -> Either TarException Header parseHeader offset bs = do unless (S.length bs == 512) $ Left $ IncompleteHeader offset - let checksumBytes = S.take 8 $ S.drop 148 bs + let checksumBytes = BU.unsafeTake 8 $ BU.unsafeDrop 148 bs expectedChecksum = parseOctal checksumBytes actualChecksum = bsum bs - bsum checksumBytes + 8 * space magicVersion = toShort $ BU.unsafeTake 8 $ BU.unsafeDrop 257 bs @@ -128,7 +128,7 @@ bsum :: ByteString -> Int bsum = S.foldl' (\c n -> c + fromIntegral n) 0 - getShort off len = toShort $ S.takeWhile (/= 0) $ S.take len $ S.drop off bs + getShort off len = toShort $ S.takeWhile (/= 0) $ BU.unsafeTake len $ BU.unsafeDrop off bs getOctal :: Integral a => Int -> Int -> a getOctal off len = parseOctal $ BU.unsafeTake len $ BU.unsafeDrop off bs @@ -322,7 +322,9 @@ | headerLinkIndicator h >= 55 -> do if (headerMagicVersion h == gnuTarMagicVersion) then handleGnuTarHeader h >>= maybe start go - else start + else dropWhileC (\x' -> case x' of + ChunkPayload _ _ -> True + _ -> False) >> start ChunkHeader h -> do payloadsConduit .| (inner (fileInfoFromHeader h) <* sinkNull) start @@ -330,7 +332,7 @@ leftover x throwM $ UnexpectedPayload offset ChunkException e -> throwM e - + -- | Take care of custom GNU tar format. handleGnuTarHeader :: MonadThrow m @@ -867,5 +869,3 @@ FilePath -> FileInfo -> ConduitM ByteString (IO ()) m () restoreFileInto cd fi = restoreFile fi {filePath = encodeFilePath (cd makeRelative "/" (getFileInfoPath fi))} - - diff --git a/tar-conduit.cabal b/tar-conduit.cabal --- a/tar-conduit.cabal +++ b/tar-conduit.cabal @@ -1,5 +1,5 @@ name: tar-conduit -version: 0.2.3 +version: 0.2.3.1 synopsis: Extract and create tar files using conduit for streaming description: Please see README.md. This is just filler to avoid warnings. homepage: https://github.com/snoyberg/tar-conduit#readme @@ -9,13 +9,15 @@ maintainer: michael@snoyman.com, bartavelle@gmail.com, alexey@kuleshevi.ch category: Data Conduit build-type: Simple -extra-source-files: README.md ChangeLog.md -cabal-version: >=1.10 +extra-source-files: README.md ChangeLog.md tests/files/libpq-0.3.tar.gz +cabal-version: >= 1.24.0.0 library + if impl(ghc < 8) + buildable: False hs-source-dirs: src exposed-modules: Data.Conduit.Tar, Data.Conduit.Tar.Types - build-depends: base >= 4.7 && < 5 + build-depends: base >= 4.9.0.0 && < 5 , bytestring , conduit , conduit-combinators >= 1.0.8.1 @@ -40,9 +42,10 @@ hs-source-dirs: tests main-is: Spec.hs build-depends: QuickCheck - , base + , base >= 4.9.0.0 , bytestring , conduit + , conduit-extra , conduit-combinators >= 1.0.8.1 , directory , filepath @@ -57,7 +60,7 @@ ghc-options: -O2 main-is: Space.hs hs-source-dirs: tests - build-depends: base + build-depends: base >= 4.9.0.0 , bytestring , conduit , conduit-combinators >= 1.0.8.1 @@ -75,7 +78,7 @@ ghc-options: -O2 main-is: Time.hs hs-source-dirs: tests - build-depends: base + build-depends: base >= 4.9.0.0 , bytestring , conduit , conduit-combinators >= 1.0.8.1 diff --git a/tests/Spec.hs b/tests/Spec.hs --- a/tests/Spec.hs +++ b/tests/Spec.hs @@ -28,7 +28,7 @@ import Data.Word #endif - +import Data.Conduit.Zlib (ungzip) main :: IO () main = do @@ -65,6 +65,19 @@ zipWithM_ shouldBe (fmap snd tb2) (fmap snd tb1) describe "ustar" ustarSpec describe "GNUtar" gnutarSpec + describe "unsupported headers" $ do + it "associated payload is discarded" $ do + contents <- readGzipTarball "./tests/files/libpq-0.3.tar.gz" + let fileNames = filePath . fst <$> contents + fileNames `shouldContain` [ "libpq-0.3/" + , "libpq-0.3/.gitignore" + , "libpq-0.3/Database/" + , "libpq-0.3/Database/PQ.hsc" + , "libpq-0.3/LICENSE" + , "libpq-0.3/README.md" + , "libpq-0.3/Setup.hs" + , "libpq-0.3/libpq.cabal" + ] defFileInfo :: FileInfo defFileInfo = @@ -223,14 +236,23 @@ readTarball :: FilePath -> IO [(FileInfo, Maybe ByteString)] readTarball fp = runConduitRes $ sourceFileBS fp .| untar grabBoth .| sinkList - where - grabBoth fi = - case fileType fi of - FTNormal -> do - content <- foldC - yield (fi, Just content) - _ -> yield (fi, Nothing) +readGzipTarball + :: FilePath + -> IO [(FileInfo, Maybe ByteString)] +readGzipTarball fp = + runConduitRes $ sourceFileBS fp .| ungzip .| untar grabBoth .| sinkList + +grabBoth + :: (Monad m) + => FileInfo + -> ConduitM ByteString (FileInfo, Maybe ByteString) m () +grabBoth fi = + case fileType fi of + FTNormal -> do + content <- foldC + yield (fi, Just content) + _ -> yield (fi, Nothing) collectContent :: FilePath -> IO (ByteString) collectContent dir = diff --git a/tests/files/libpq-0.3.tar.gz b/tests/files/libpq-0.3.tar.gz new file mode 100644 Binary files /dev/null and b/tests/files/libpq-0.3.tar.gz differ