Skip to content

Commit

Permalink
Merge pull request haskell#9557 from ffaf1/tar-relax
Browse files Browse the repository at this point in the history
Relax `tar` upper bound
  • Loading branch information
mergify[bot] authored Jan 7, 2024
2 parents 47627e4 + 51e6483 commit 49e3d18
Show file tree
Hide file tree
Showing 5 changed files with 80 additions and 37 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
7 changes: 5 additions & 2 deletions cabal-install/cabal-install.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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,
Expand Down
68 changes: 68 additions & 0 deletions cabal-install/src/Distribution/Client/Compat/Tar.hs
Original file line number Diff line number Diff line change
@@ -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 -}
31 changes: 2 additions & 29 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,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.
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 49e3d18

Please sign in to comment.