diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/libarchive.cabal b/libarchive.cabal --- a/libarchive.cabal +++ b/libarchive.cabal @@ -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, diff --git a/src/Codec/Archive/Internal/Unpack.hs b/src/Codec/Archive/Internal/Unpack.hs --- a/src/Codec/Archive/Internal/Unpack.hs +++ b/src/Codec/Archive/Internal/Unpack.hs @@ -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 () diff --git a/src/Codec/Archive/Internal/Unpack/Lazy.hs b/src/Codec/Archive/Internal/Unpack/Lazy.hs --- a/src/Codec/Archive/Internal/Unpack/Lazy.hs +++ b/src/Codec/Archive/Internal/Unpack/Lazy.hs @@ -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 diff --git a/test/Spec.cpphs b/test/Spec.cpphs --- a/test/Spec.cpphs +++ b/test/Spec.cpphs @@ -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 diff --git a/test/data/plan_json.zip b/test/data/plan_json.zip new file mode 100644 Binary files /dev/null and b/test/data/plan_json.zip differ