From eaf2aae18603965ff668384b391fcaa14de19823 Mon Sep 17 00:00:00 2001
From: Mikhail Glushenkov <mikhail.glushenkov@gmail.com>
Date: Mon, 26 May 2014 20:17:03 +0200
Subject: [PATCH] 'Setup.hs sdist': invoke 'tar' with '--format ustar' if
possible.
Fixes #1901. Some variants of 'tar' don't support the '--format' option, so we
have to do feature detection.
Note that 'cabal sdist' (as opposed to 'Setup.hs sdist') uses the built-in
tar.gz archiver ('Distribution.Client.Tar') and doesn't invoke 'tar' or 'gzip'.
---
Cabal/Distribution/Simple/Program/Builtin.hs | 22 +++++++++++++++++---
Cabal/Distribution/Simple/Program/Db.hs | 1 +
Cabal/Distribution/Simple/Program/Types.hs | 7 +++++++
Cabal/Distribution/Simple/SrcDist.hs | 20 +++++++++++-------
4 files changed, 39 insertions(+), 11 deletions(-)
diff --git a/Cabal/Distribution/Simple/Program/Builtin.hs b/Cabal/Distribution/Simple/Program/Builtin.hs
index 8ae880182f..291b6f51ac 100644
--- a/Cabal/Distribution/Simple/Program/Builtin.hs
+++ b/Cabal/Distribution/Simple/Program/Builtin.hs
@@ -46,13 +46,19 @@ module Distribution.Simple.Program.Builtin (
hpcProgram,
) where
-import Distribution.Simple.Program.Types
- ( Program(..), simpleProgram )
import Distribution.Simple.Program.Find
( findProgramOnSearchPath )
+import Distribution.Simple.Program.Run
+ ( getProgramInvocationOutput, programInvocation )
+import Distribution.Simple.Program.Types
+ ( Program(..), ConfiguredProgram(..), simpleProgram )
import Distribution.Simple.Utils
( findProgramVersion )
+import Data.List
+ ( isInfixOf )
+import qualified Data.Map as Map
+
-- ------------------------------------------------------------
-- * Known programs
-- ------------------------------------------------------------
@@ -292,7 +298,17 @@ ldProgram :: Program
ldProgram = simpleProgram "ld"
tarProgram :: Program
-tarProgram = simpleProgram "tar"
+tarProgram = (simpleProgram "tar") {
+ -- See #1901. Some versions of 'tar' (OpenBSD, NetBSD, ...) don't support the
+ -- '--format' option.
+ programPostConf = \verbosity tarProg -> do
+ tarHelpOutput <- getProgramInvocationOutput
+ verbosity (programInvocation tarProg ["--help"])
+ let k = "Supports --format"
+ v = if ("--format" `isInfixOf` tarHelpOutput) then "YES" else "NO"
+ m = Map.insert k v (programProperties tarProg)
+ return $ tarProg { programProperties = m }
+ }
cppProgram :: Program
cppProgram = simpleProgram "cpp"
diff --git a/Cabal/Distribution/Simple/Program/Db.hs b/Cabal/Distribution/Simple/Program/Db.hs
index 12c240d2e9..f2fbc9b22f 100644
--- a/Cabal/Distribution/Simple/Program/Db.hs
+++ b/Cabal/Distribution/Simple/Program/Db.hs
@@ -337,6 +337,7 @@ configureProgram verbosity prog conf = do
programDefaultArgs = [],
programOverrideArgs = userSpecifiedArgs prog conf,
programOverrideEnv = [("PATH", Just newPath)],
+ programProperties = Map.empty,
programLocation = location
}
configuredProg' <- programPostConf prog verbosity configuredProg
diff --git a/Cabal/Distribution/Simple/Program/Types.hs b/Cabal/Distribution/Simple/Program/Types.hs
index eb97e388a5..852d1329f3 100644
--- a/Cabal/Distribution/Simple/Program/Types.hs
+++ b/Cabal/Distribution/Simple/Program/Types.hs
@@ -41,6 +41,7 @@ import Distribution.Verbosity
( Verbosity )
import Data.Binary (Binary)
+import qualified Data.Map as Map
import GHC.Generics (Generic)
-- | Represents a program which can be configured.
@@ -101,6 +102,11 @@ data ConfiguredProgram = ConfiguredProgram {
-- the current to form the environment for the new process.
programOverrideEnv :: [(String, Maybe String)],
+ -- | A key-value map listing various properties of the program, useful
+ -- for feature detection. Populated during the configuration step, key
+ -- names depend on the specific program.
+ programProperties :: Map.Map String String,
+
-- | Location of the program. eg. @\/usr\/bin\/ghc-6.4@
programLocation :: ProgramLocation
} deriving (Eq, Generic, Read, Show)
@@ -153,5 +159,6 @@ simpleConfiguredProgram name loc = ConfiguredProgram {
programDefaultArgs = [],
programOverrideArgs = [],
programOverrideEnv = [],
+ programProperties = Map.empty,
programLocation = loc
}
diff --git a/Cabal/Distribution/Simple/SrcDist.hs b/Cabal/Distribution/Simple/SrcDist.hs
index fde88abc53..67f1862b52 100644
--- a/Cabal/Distribution/Simple/SrcDist.hs
+++ b/Cabal/Distribution/Simple/SrcDist.hs
@@ -66,13 +66,14 @@ import Distribution.Simple.LocalBuildInfo
( LocalBuildInfo(..), withAllComponentsInBuildOrder )
import Distribution.Simple.BuildPaths ( autogenModuleName )
import Distribution.Simple.Program ( defaultProgramConfiguration, requireProgram,
- rawSystemProgram, tarProgram )
+ runProgram, programProperties, tarProgram )
import Distribution.Text
( display )
import Control.Monad(when, unless, forM)
import Data.Char (toLower)
import Data.List (partition, isPrefixOf)
+import qualified Data.Map as Map
import Data.Maybe (isNothing, catMaybes)
import Data.Time (UTCTime, getCurrentTime, toGregorian, utctDay)
import System.Directory ( doesFileExist )
@@ -411,13 +412,16 @@ createArchive verbosity pkg_descr mb_lbi tmpDir targetPref = do
(tarProg, _) <- requireProgram verbosity tarProgram
(maybe defaultProgramConfiguration withPrograms mb_lbi)
-
- -- Hmm: I could well be skating on thinner ice here by using the -C option
- -- (=> GNU tar-specific?) [The prev. solution used pipes and sub-command
- -- sequences to set up the paths correctly, which is problematic in a Windows
- -- setting.]
- rawSystemProgram verbosity tarProg
- ["-czf", tarBallFilePath, "-C", tmpDir, tarBallName pkg_descr]
+ let tarProgSupportsFormatOpt = maybe False (== "YES") $
+ Map.lookup "Supports --format"
+ (programProperties tarProg)
+ runProgram verbosity tarProg
+ . (if tarProgSupportsFormatOpt then (++) ["--format", "ustar"] else id)
+ -- Hmm: I could well be skating on thinner ice here by using the -C option
+ -- (=> seems to be supported at least by GNU and *BSD tar) [The
+ -- prev. solution used pipes and sub-command sequences to set up the paths
+ -- correctly, which is problematic in a Windows setting.]
+ $ ["-czf", tarBallFilePath, "-C", tmpDir, tarBallName pkg_descr]
return tarBallFilePath
-- | Given a buildinfo, return the names of all source files.
--
GitLab