libarchive 3.0.5.0 → 3.0.6.0
raw patch · 6 files changed
+55/−5 lines, 6 filesdep +base16-bytestringdep +cryptohash-sha256dep +textbinary-added
Dependencies added: base16-bytestring, cryptohash-sha256, text
Files
- CHANGELOG.md +4/−0
- libarchive.cabal +7/−1
- src/Codec/Archive/Internal/Unpack.hs +12/−3
- src/Codec/Archive/Internal/Unpack/Lazy.hs +2/−0
- test/Spec.cpphs +30/−1
- test/data/plan_json.zip binary
CHANGELOG.md view
@@ -1,5 +1,9 @@ # libarchive +# 3.0.6.0++ * Refuse to unpack malicious tarballs (i.e. any file starting with `..`)+ # 3.0.5.0 * use libarchive-clib package
libarchive.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: libarchive-version: 3.0.5.0+version: 3.0.6.0 license: BSD-3-Clause license-file: LICENSE copyright: Copyright: (c) 2018-2020 Vanessa McHale@@ -16,6 +16,7 @@ build-type: Custom extra-source-files: test/data/aarch64-linux-dist.tar+ test/data/plan_json.zip extra-doc-files: README.md@@ -130,6 +131,8 @@ libarchive, lzma-static, time,+ cryptohash-sha256,+ base16-bytestring, zlib ^>=0.7.1.1 if flag(no-exe)@@ -149,6 +152,8 @@ ghc-options: -threaded -rtsopts "-with-rtsopts=-N -K1K" -Wall build-depends: base,+ base16-bytestring,+ cryptohash-sha256, deepseq, libarchive, hspec,@@ -156,6 +161,7 @@ directory >=1.2.5.0, filepath, temporary,+ text, mtl >=2.2.2, dir-traverse, composition-prelude >=2.0.5.0,
src/Codec/Archive/Internal/Unpack.hs view
@@ -20,7 +20,8 @@ import Codec.Archive.Foreign import Codec.Archive.Internal.Monad import Codec.Archive.Types-import Control.Monad ((<=<))+import Control.Monad (when, (<=<))+import Control.Monad.Except (throwError) import Control.Monad.IO.Class (liftIO) import qualified Control.Monad.ST.Lazy as LazyST import qualified Control.Monad.ST.Lazy.Unsafe as LazyST@@ -34,7 +35,7 @@ import Foreign.Marshal.Alloc (allocaBytes, free, mallocBytes) import Foreign.Marshal.Utils (copyBytes) import Foreign.Ptr (castPtr, nullPtr)-import System.FilePath ((</>))+import System.FilePath (normalise, splitDirectories, (</>)) import System.IO.Unsafe (unsafeDupablePerformIO) -- | Read an archive contained in a 'BS.ByteString'. The format of the archive is@@ -152,7 +153,13 @@ Nothing -> pure [] Just x -> (x:) <$> hsEntriesSTAbs read' a --- | Unpack an archive in a given directory+abortIfSuspect :: FilePath -> ArchiveM ()+abortIfSuspect fp | ("..":_) <- splitDirectories (normalise fp) = throwError ArchiveFatal+ | otherwise = pure ()++-- | Unpack an archive in a given directory.+--+-- Throws 'ArchiveFatal' if any entry's path begins with @".."@ unpackEntriesFp :: ArchivePtr -> FilePath -> ArchiveM () unpackEntriesFp a fp = do res <- liftIO $ getEntry a@@ -161,6 +168,7 @@ Just x -> do preFile <- liftIO $ archiveEntryPathname x file <- liftIO $ peekCString preFile+ abortIfSuspect file let file' = fp </> file liftIO $ withCString file' $ \fileC -> archiveEntrySetPathname x fileC@@ -253,6 +261,7 @@ then pure Nothing else Just . castForeignPtr <$> newForeignPtr_ (castPtr res) +-- | Throws 'ArchiveFatal' if any entry's path begins with @".."@ unpackToDir :: FilePath -- ^ Directory to unpack in -> BS.ByteString -- ^ 'BS.ByteString' containing archive -> ArchiveM ()
src/Codec/Archive/Internal/Unpack/Lazy.hs view
@@ -27,6 +27,8 @@ -- | In general, this will be more efficient than 'unpackToDir' --+-- Throws 'ArchiveFatal' if any entry's path begins with @".."@+-- -- @since 1.0.4.0 unpackToDirLazy :: FilePath -- ^ Directory to unpack in -> BSL.ByteString -- ^ 'BSL.ByteString' containing archive
test/Spec.cpphs view
@@ -1,4 +1,6 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE LambdaCase #-} module Main ( main ) where import Codec.Archive@@ -7,6 +9,7 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL import Data.Either (isRight)+import Data.List (uncons) import Data.Foldable (traverse_) import System.Directory (doesDirectoryExist, listDirectory) import System.FilePath ((</>))@@ -19,6 +22,11 @@ #endif import Test.Hspec +import qualified Data.ByteString.Base16 as B16+import qualified Crypto.Hash.SHA256 as SHA256+import qualified Data.Text.Encoding as E+import qualified Data.Text as T+ testFp :: FilePath -> Spec testFp fp = it ("sucessfully unpacks/packs (" ++ fp ++ ")") $ roundtrip fp >>= (`shouldSatisfy` isRight)@@ -58,6 +66,20 @@ bsValid :: Either a BSL.ByteString -> Bool bsValid = \x -> case x of { Left{} -> False; Right b -> not $ BSL.null b } +testArchiveContentChecksum :: FilePath -- ^ archive+ -> FilePath -- ^ file inside archive+ -> String -- ^ base64 encoded sha256sum+ -> Spec+testArchiveContentChecksum archive file sha = it ("Verify checksum of " <> file <> " in archive " <> archive) $ do+ entries' <- runArchiveM (readArchiveFile archive)+ entries <- either (ioError . userError . show) pure $ entries'+ let cabal_exe = uncons . fmap content . filter (\Entry{..} -> filepath == file) $ entries+ c <- case cabal_exe of+ (Just (NormalFile c, _)) -> pure c+ _ -> ioError $ userError $ "Could not find file " <> file <> " in archive " <> archive+ digest <- either (ioError . userError . show) pure . E.decodeUtf8' . B16.encode . SHA256.hash $ c+ digest `shouldBe` T.pack sha+ main :: IO () main = do @@ -65,7 +87,7 @@ tarballs <- if dir then listDirectory "test/data" else pure [] let tarPaths = ("test/data" </>) <$> tarballs - hspec' $+ hspec' $ do describe "roundtrip" $ do traverse_ testFp tarPaths@@ -113,6 +135,13 @@ [ stripOwnership (simpleFile "a.txt" (NormalFile "text")) ] xcontext "having entry without timestamp" . itPacksUnpacks $ [ stripTime (simpleFile "a.txt" (NormalFile "text")) ]++ describe "checksums" $ do+ testArchiveContentChecksum+ "test/data/plan_json.zip"+ "plan.json"+ "5eac50e94666fff2491e43f81a670ef243c272aa3afe1fc59c720004fe186feb"+ where #ifdef mingw32_HOST_OS hspec' spec = getArgs >>= readConfig defaultConfig >>= (\c -> withArgs [] . runSpec spec $ c{ configConcurrentJobs = Nothing }) >>= evaluateSummary
+ test/data/plan_json.zip view
binary file changed (absent → 22618 bytes)