Skip to content

Commit 51e6483

Browse files
committed
Relax tar upper bound
* Add a `Compat` module to accomodate two different `tar` interfaces. * Tweak `-Wunused-packages` conditional (thanks Phil de Joux)
1 parent 47627e4 commit 51e6483

File tree

5 files changed

+80
-37
lines changed

5 files changed

+80
-37
lines changed

Cabal-tests/Cabal-tests.cabal

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -167,7 +167,7 @@ test-suite hackage-tests
167167
, clock >=0.8 && <0.9
168168
, optparse-applicative >=0.13.2.0 && <0.19
169169
, stm >=2.4.5.0 && <2.6
170-
, tar >=0.5.0.3 && <0.6
170+
, tar >=0.5.0.3 && <0.7
171171
, tree-diff >=0.1 && <0.4
172172

173173
ghc-options: -Wall -rtsopts -threaded

cabal-install/cabal-install.cabal

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -42,7 +42,9 @@ common warnings
4242
ghc-options: -Wall -Wcompat -Wnoncanonical-monad-instances -Wincomplete-uni-patterns -Wincomplete-record-updates
4343
if impl(ghc < 8.8)
4444
ghc-options: -Wnoncanonical-monadfail-instances
45-
if impl(ghc >=8.10)
45+
if impl(ghc >=9.0)
46+
-- Warning: even though introduced with GHC 8.10, -Wunused-packages
47+
-- gives false positives with GHC 8.10.
4648
ghc-options: -Wunused-packages
4749

4850
common base-dep
@@ -103,6 +105,7 @@ library
103105
Distribution.Client.Compat.Orphans
104106
Distribution.Client.Compat.Prelude
105107
Distribution.Client.Compat.Semaphore
108+
Distribution.Client.Compat.Tar
106109
Distribution.Client.Config
107110
Distribution.Client.Configure
108111
Distribution.Client.Dependency
@@ -227,7 +230,7 @@ library
227230
process >= 1.2.3.0 && < 1.7,
228231
random >= 1.2 && < 1.3,
229232
stm >= 2.0 && < 2.6,
230-
tar >= 0.5.0.3 && < 0.6,
233+
tar >= 0.5.0.3 && < 0.7,
231234
time >= 1.5.0.1 && < 1.13,
232235
zlib >= 0.5.3 && < 0.7,
233236
hackage-security >= 0.6.2.0 && < 0.7,
Lines changed: 68 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,68 @@
1+
{-# LANGUAGE CPP #-}
2+
{-# OPTIONS_GHC -fno-warn-orphans #-}
3+
4+
{- FOURMOLU_DISABLE -}
5+
module Distribution.Client.Compat.Tar
6+
( extractTarGzFile
7+
#if MIN_VERSION_tar(0,6,0)
8+
, Tar.Entry
9+
, Tar.Entries
10+
, Tar.GenEntries (..)
11+
, Tar.GenEntryContent (..)
12+
, Tar.entryContent
13+
#else
14+
, Tar.Entries (..)
15+
, Tar.Entry (..)
16+
, Tar.EntryContent (..)
17+
#endif
18+
) where
19+
{- FOURMOLU_ENABLE -}
20+
21+
import Distribution.Client.Compat.Prelude
22+
import Prelude ()
23+
24+
import qualified Codec.Archive.Tar as Tar
25+
import qualified Codec.Archive.Tar.Check as Tar
26+
#if MIN_VERSION_tar(0,6,0)
27+
#else
28+
import qualified Codec.Archive.Tar.Entry as Tar
29+
#endif
30+
import qualified Data.ByteString.Lazy as BS
31+
import qualified Distribution.Client.GZipUtils as GZipUtils
32+
33+
instance (Exception a, Exception b) => Exception (Either a b) where
34+
toException (Left e) = toException e
35+
toException (Right e) = toException e
36+
37+
fromException e =
38+
case fromException e of
39+
Just e' -> Just (Left e')
40+
Nothing -> case fromException e of
41+
Just e' -> Just (Right e')
42+
Nothing -> Nothing
43+
44+
{- FOURMOLU_DISABLE -}
45+
extractTarGzFile
46+
:: FilePath
47+
-- ^ Destination directory
48+
-> FilePath
49+
-- ^ Expected subdir (to check for tarbombs)
50+
-> FilePath
51+
-- ^ Tarball
52+
-> IO ()
53+
extractTarGzFile dir expected tar =
54+
#if MIN_VERSION_tar(0,6,0)
55+
Tar.unpackAndCheck
56+
( \x ->
57+
SomeException <$> Tar.checkEntryTarbomb expected x
58+
<|> SomeException <$> Tar.checkEntrySecurity x
59+
)
60+
dir
61+
#else
62+
Tar.unpack dir
63+
. Tar.checkTarbomb expected
64+
#endif
65+
. Tar.read
66+
. GZipUtils.maybeDecompress
67+
=<< BS.readFile tar
68+
{- FOURMOLU_ENABLE -}

cabal-install/src/Distribution/Client/Tar.hs

Lines changed: 2 additions & 29 deletions
Original file line numberDiff line numberDiff line change
@@ -19,7 +19,7 @@
1919
module Distribution.Client.Tar
2020
( -- * @tar.gz@ operations
2121
createTarGzFile
22-
, extractTarGzFile
22+
, TarComp.extractTarGzFile
2323

2424
-- * Other local utils
2525
, buildTreeRefTypeCode
@@ -34,11 +34,10 @@ import Distribution.Client.Compat.Prelude
3434
import Prelude ()
3535

3636
import qualified Codec.Archive.Tar as Tar
37-
import qualified Codec.Archive.Tar.Check as Tar
3837
import qualified Codec.Archive.Tar.Entry as Tar
3938
import qualified Codec.Compression.GZip as GZip
4039
import qualified Data.ByteString.Lazy as BS
41-
import qualified Distribution.Client.GZipUtils as GZipUtils
40+
import qualified Distribution.Client.Compat.Tar as TarComp
4241

4342
-- for foldEntries...
4443
import Control.Exception (throw)
@@ -60,32 +59,6 @@ createTarGzFile
6059
createTarGzFile tar base dir =
6160
BS.writeFile tar . GZip.compress . Tar.write =<< Tar.pack base [dir]
6261

63-
extractTarGzFile
64-
:: FilePath
65-
-- ^ Destination directory
66-
-> FilePath
67-
-- ^ Expected subdir (to check for tarbombs)
68-
-> FilePath
69-
-- ^ Tarball
70-
-> IO ()
71-
extractTarGzFile dir expected tar =
72-
Tar.unpack dir
73-
. Tar.checkTarbomb expected
74-
. Tar.read
75-
. GZipUtils.maybeDecompress
76-
=<< BS.readFile tar
77-
78-
instance (Exception a, Exception b) => Exception (Either a b) where
79-
toException (Left e) = toException e
80-
toException (Right e) = toException e
81-
82-
fromException e =
83-
case fromException e of
84-
Just e' -> Just (Left e')
85-
Nothing -> case fromException e of
86-
Just e' -> Just (Right e')
87-
Nothing -> Nothing
88-
8962
-- | Type code for the local build tree reference entry type. We don't use the
9063
-- symbolic link entry type because it allows only 100 ASCII characters for the
9164
-- path.

cabal-install/tests/UnitTests/Distribution/Client/Tar.hs

Lines changed: 4 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -3,13 +3,10 @@ module UnitTests.Distribution.Client.Tar
33
) where
44

55
import Codec.Archive.Tar
6-
( Entries (..)
7-
, foldEntries
6+
( foldEntries
87
)
98
import Codec.Archive.Tar.Entry
10-
( Entry (..)
11-
, EntryContent (..)
12-
, simpleEntry
9+
( simpleEntry
1310
, toTarPath
1411
)
1512
import Distribution.Client.Tar
@@ -24,6 +21,8 @@ import Control.Monad.Writer.Lazy (runWriterT, tell)
2421
import qualified Data.ByteString.Lazy as BS
2522
import qualified Data.ByteString.Lazy.Char8 as BS.Char8
2623

24+
import Distribution.Client.Compat.Tar
25+
2726
tests :: [TestTree]
2827
tests =
2928
[ testCase "filterEntries" filterTest

0 commit comments

Comments
 (0)