diff --git a/Cabal-tests/Cabal-tests.cabal b/Cabal-tests/Cabal-tests.cabal index f6a8c2c1481..42e8945969e 100644 --- a/Cabal-tests/Cabal-tests.cabal +++ b/Cabal-tests/Cabal-tests.cabal @@ -160,7 +160,7 @@ test-suite hackage-tests , clock >=0.8 && <0.9 , optparse-applicative >=0.13.2.0 && <0.19 , stm >=2.4.5.0 && <2.6 - , tar >=0.5.0.3 && <0.6 + , tar >=0.5.0.3 && <0.7 , tree-diff >=0.1 && <0.4 ghc-options: -Wall -rtsopts -threaded diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index 344cf8249af..b0cd99ed7d3 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -42,7 +42,9 @@ common warnings ghc-options: -Wall -Wcompat -Wnoncanonical-monad-instances -Wincomplete-uni-patterns -Wincomplete-record-updates if impl(ghc < 8.8) ghc-options: -Wnoncanonical-monadfail-instances - if impl(ghc >=8.10) + if impl(ghc >=9.0) + -- Warning: even though introduced with GHC 8.10, -Wunused-packages + -- gives false positives with GHC 8.10. ghc-options: -Wunused-packages common base-dep @@ -103,6 +105,7 @@ library Distribution.Client.Compat.Orphans Distribution.Client.Compat.Prelude Distribution.Client.Compat.Semaphore + Distribution.Client.Compat.Tar Distribution.Client.Config Distribution.Client.Configure Distribution.Client.Dependency @@ -224,7 +227,7 @@ library process >= 1.2.3.0 && < 1.7, random >= 1.2 && < 1.3, stm >= 2.0 && < 2.6, - tar >= 0.5.0.3 && < 0.6, + tar >= 0.5.0.3 && < 0.7, time >= 1.5.0.1 && < 1.13, zlib >= 0.5.3 && < 0.7, hackage-security >= 0.6.2.0 && < 0.7, diff --git a/cabal-install/src/Distribution/Client/Compat/Tar.hs b/cabal-install/src/Distribution/Client/Compat/Tar.hs new file mode 100644 index 00000000000..8597c61fede --- /dev/null +++ b/cabal-install/src/Distribution/Client/Compat/Tar.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +{- FOURMOLU_DISABLE -} +module Distribution.Client.Compat.Tar + ( extractTarGzFile +#if MIN_VERSION_tar(0,6,0) + , Tar.Entry + , Tar.Entries + , Tar.GenEntries (..) + , Tar.GenEntryContent (..) + , Tar.entryContent +#else + , Tar.Entries (..) + , Tar.Entry (..) + , Tar.EntryContent (..) +#endif + ) where +{- FOURMOLU_ENABLE -} + +import Distribution.Client.Compat.Prelude +import Prelude () + +import qualified Codec.Archive.Tar as Tar +import qualified Codec.Archive.Tar.Check as Tar +#if MIN_VERSION_tar(0,6,0) +#else +import qualified Codec.Archive.Tar.Entry as Tar +#endif +import qualified Data.ByteString.Lazy as BS +import qualified Distribution.Client.GZipUtils as GZipUtils + +instance (Exception a, Exception b) => Exception (Either a b) where + toException (Left e) = toException e + toException (Right e) = toException e + + fromException e = + case fromException e of + Just e' -> Just (Left e') + Nothing -> case fromException e of + Just e' -> Just (Right e') + Nothing -> Nothing + +{- FOURMOLU_DISABLE -} +extractTarGzFile + :: FilePath + -- ^ Destination directory + -> FilePath + -- ^ Expected subdir (to check for tarbombs) + -> FilePath + -- ^ Tarball + -> IO () +extractTarGzFile dir expected tar = +#if MIN_VERSION_tar(0,6,0) + Tar.unpackAndCheck + ( \x -> + SomeException <$> Tar.checkEntryTarbomb expected x + <|> SomeException <$> Tar.checkEntrySecurity x + ) + dir +#else + Tar.unpack dir + . Tar.checkTarbomb expected +#endif + . Tar.read + . GZipUtils.maybeDecompress + =<< BS.readFile tar +{- FOURMOLU_ENABLE -} diff --git a/cabal-install/src/Distribution/Client/Tar.hs b/cabal-install/src/Distribution/Client/Tar.hs index d59dcf8160a..f9b146a3dd4 100644 --- a/cabal-install/src/Distribution/Client/Tar.hs +++ b/cabal-install/src/Distribution/Client/Tar.hs @@ -14,10 +14,11 @@ -- Reading, writing and manipulating \"@.tar@\" archive files. -- ----------------------------------------------------------------------------- -module Distribution.Client.Tar ( - -- * @tar.gz@ operations + +module Distribution.Client.Tar + ( -- * @tar.gz@ operations createTarGzFile, - extractTarGzFile, + TarComp.extractTarGzFile, -- * Other local utils buildTreeRefTypeCode, @@ -31,12 +32,11 @@ module Distribution.Client.Tar ( import Distribution.Client.Compat.Prelude import Prelude () -import qualified Data.ByteString.Lazy as BS -import qualified Codec.Archive.Tar as Tar +import qualified Codec.Archive.Tar as Tar import qualified Codec.Archive.Tar.Entry as Tar -import qualified Codec.Archive.Tar.Check as Tar -import qualified Codec.Compression.GZip as GZip -import qualified Distribution.Client.GZipUtils as GZipUtils +import qualified Codec.Compression.GZip as GZip +import qualified Data.ByteString.Lazy as BS +import qualified Distribution.Client.Compat.Tar as TarComp -- for foldEntries... import Control.Exception (throw) @@ -52,26 +52,6 @@ createTarGzFile :: FilePath -- ^ Full Tarball path createTarGzFile tar base dir = BS.writeFile tar . GZip.compress . Tar.write =<< Tar.pack base [dir] -extractTarGzFile :: FilePath -- ^ Destination directory - -> FilePath -- ^ Expected subdir (to check for tarbombs) - -> FilePath -- ^ Tarball - -> IO () -extractTarGzFile dir expected tar = - Tar.unpack dir . Tar.checkTarbomb expected . Tar.read - . GZipUtils.maybeDecompress =<< BS.readFile tar - -instance (Exception a, Exception b) => Exception (Either a b) where - toException (Left e) = toException e - toException (Right e) = toException e - - fromException e = - case fromException e of - Just e' -> Just (Left e') - Nothing -> case fromException e of - Just e' -> Just (Right e') - Nothing -> Nothing - - -- | Type code for the local build tree reference entry type. We don't use the -- symbolic link entry type because it allows only 100 ASCII characters for the -- path. diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Tar.hs b/cabal-install/tests/UnitTests/Distribution/Client/Tar.hs index 8b70dd89e4c..62f725e270e 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/Tar.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/Tar.hs @@ -2,17 +2,17 @@ module UnitTests.Distribution.Client.Tar ( tests ) where -import Distribution.Client.Tar ( filterEntries - , filterEntriesM - ) -import Codec.Archive.Tar ( Entries(..) - , foldEntries - ) -import Codec.Archive.Tar.Entry ( EntryContent(..) - , simpleEntry - , Entry(..) - , toTarPath - ) +import Codec.Archive.Tar + ( foldEntries + ) +import Codec.Archive.Tar.Entry + ( simpleEntry + , toTarPath + ) +import Distribution.Client.Tar + ( filterEntries + , filterEntriesM + ) import Test.Tasty import Test.Tasty.HUnit @@ -21,6 +21,8 @@ import qualified Data.ByteString.Lazy as BS import qualified Data.ByteString.Lazy.Char8 as BS.Char8 import Control.Monad.Writer.Lazy (runWriterT, tell) +import Distribution.Client.Compat.Tar + tests :: [TestTree] tests = [ testCase "filterEntries" filterTest , testCase "filterEntriesM" filterMTest