Relax tar upper bound

* Add a `Compat` module to accomodate two different `tar` interfaces.
ffaf1 · Dec 30, 2023 · 94a4995 · 94a4995
1 parent ce5d0f7
commit 94a4995
Show file tree

Hide file tree

Showing 5 changed files with 77 additions and 36 deletions.
diff --git 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
@@ -103,6 +103,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 +228,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
@@ -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
@@ -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
@@ -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