Skip to content

Commit

Permalink
Relax tar upper bound
Browse files Browse the repository at this point in the history
* Add a `Compat` module to accomodate two different `tar` interfaces.
  • Loading branch information
ffaf1 committed Dec 30, 2023
1 parent ce5d0f7 commit 60ae9cf
Show file tree
Hide file tree
Showing 5 changed files with 68 additions and 25 deletions.
2 changes: 1 addition & 1 deletion Cabal-tests/Cabal-tests.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
3 changes: 2 additions & 1 deletion cabal-install/cabal-install.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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,
Expand Down
59 changes: 59 additions & 0 deletions cabal-install/src/Distribution/Client/Compat/Tar.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,59 @@
{-# LANGUAGE CPP #-}

{- 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

-- Instances.
import Control.Exception ()

This comment has been minimized.

Copy link
@Bodigrim

Bodigrim Dec 30, 2023

Collaborator

There is no instance Exception (Either e1 e2) at the moment (see haskell/core-libraries-committee#233). Something stupid like either throwIO throwIO should do.


{- 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 -}
20 changes: 2 additions & 18 deletions cabal-install/src/Distribution/Client/Tar.hs
Original file line number Diff line number Diff line change
Expand Up @@ -19,7 +19,7 @@
module Distribution.Client.Tar
( -- * @tar.gz@ operations
createTarGzFile
, extractTarGzFile
, TarComp.extractTarGzFile

-- * Other local utils
, buildTreeRefTypeCode
Expand All @@ -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)
Expand All @@ -60,21 +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
Expand Down
9 changes: 4 additions & 5 deletions cabal-install/tests/UnitTests/Distribution/Client/Tar.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down

0 comments on commit 60ae9cf

Please sign in to comment.