Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Relax tar upper bound #9557

Merged
merged 1 commit into from
Jan 7, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
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
Loading