From 51e6483f95ecb4f395dce36e47af296902a75143 Mon Sep 17 00:00:00 2001 From: Francesco Ariis Date: Sat, 23 Dec 2023 15:56:58 +0100 Subject: [PATCH] Relax `tar` upper bound * Add a `Compat` module to accomodate two different `tar` interfaces. * Tweak `-Wunused-packages` conditional (thanks Phil de Joux) --- Cabal-tests/Cabal-tests.cabal | 2 +- cabal-install/cabal-install.cabal | 7 +- .../src/Distribution/Client/Compat/Tar.hs | 68 +++++++++++++++++++ cabal-install/src/Distribution/Client/Tar.hs | 31 +-------- .../UnitTests/Distribution/Client/Tar.hs | 9 ++- 5 files changed, 80 insertions(+), 37 deletions(-) create mode 100644 cabal-install/src/Distribution/Client/Compat/Tar.hs diff --git a/Cabal-tests/Cabal-tests.cabal b/Cabal-tests/Cabal-tests.cabal index c2e3047da04..19572b2d0d1 100644 --- a/Cabal-tests/Cabal-tests.cabal +++ b/Cabal-tests/Cabal-tests.cabal @@ -167,7 +167,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 3cb68deb661..2ef1929e6af 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 @@ -227,7 +230,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 313821a6b1a..4c5957d89d3 100644 --- a/cabal-install/src/Distribution/Client/Tar.hs +++ b/cabal-install/src/Distribution/Client/Tar.hs @@ -19,7 +19,7 @@ module Distribution.Client.Tar ( -- * @tar.gz@ operations createTarGzFile - , extractTarGzFile + , TarComp.extractTarGzFile -- * Other local utils , buildTreeRefTypeCode @@ -34,11 +34,10 @@ import Distribution.Client.Compat.Prelude import Prelude () import qualified Codec.Archive.Tar as Tar -import qualified Codec.Archive.Tar.Check as Tar import qualified Codec.Archive.Tar.Entry as Tar import qualified Codec.Compression.GZip as GZip import qualified Data.ByteString.Lazy as BS -import qualified Distribution.Client.GZipUtils as GZipUtils +import qualified Distribution.Client.Compat.Tar as TarComp -- for foldEntries... import Control.Exception (throw) @@ -60,32 +59,6 @@ createTarGzFile 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 6295de6ace8..8bb8801c04e 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/Tar.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/Tar.hs @@ -3,13 +3,10 @@ module UnitTests.Distribution.Client.Tar ) where import Codec.Archive.Tar - ( Entries (..) - , foldEntries + ( foldEntries ) import Codec.Archive.Tar.Entry - ( Entry (..) - , EntryContent (..) - , simpleEntry + ( simpleEntry , toTarPath ) import Distribution.Client.Tar @@ -24,6 +21,8 @@ import Control.Monad.Writer.Lazy (runWriterT, tell) import qualified Data.ByteString.Lazy as BS import qualified Data.ByteString.Lazy.Char8 as BS.Char8 +import Distribution.Client.Compat.Tar + tests :: [TestTree] tests = [ testCase "filterEntries" filterTest