Commit 0a4aed40 authored by barmston's avatar barmston

cabal install can be used inside a cabal exec environment

Inside a cabal exec environment cabal should be configured to always use the
correct environment. When there is a sandbox this is addressed by setting the
CABAL_SANDBOX_CONFIG environment variable.

However GHC is configured to use the correct package database through setting
the GHC_PACKAGE_PATH environment variable to include the sandbox database. The
Cabal library previously refused to operate when GHC_PACKAGE_PATH is set in
order to avoid having a different view of the package databases to GHC.

In the case of a cabal exec environment being loaded for a cabal sandbox, it
is safe to allow the use of GHC_PACKAGE_PATH as it is being used to ensure
that GHC uses the same package database as cabal does.

A check is made that GHC_PACKAGE_PATH matches the value that cabal exec set it
to. If it does use of GHC through cabal is permitted.

Fixes #1800
parent 93b2e257
......@@ -117,7 +117,6 @@ import System.FilePath ( (</>), (<.>), takeExtension,
splitExtension, isRelative )
import qualified System.Info
import System.IO (hClose, hPutStrLn)
import System.Environment (getEnv)
import Distribution.Compat.Exception (catchIO)
-- -----------------------------------------------------------------------------
......@@ -311,18 +310,9 @@ getGlobalPackageDB verbosity ghcProg =
dropWhileEndLE isSpace `fmap`
rawSystemProgramStdout verbosity ghcProg ["--print-global-package-db"]
-- Cabal does not use the environment variable GHC_PACKAGE_PATH; let users
-- know that this is the case. See ticket #335. Simply ignoring it is not a
-- good idea, since then ghc and cabal are looking at different sets of
-- package DBs and chaos is likely to ensue.
checkPackageDbEnvVar :: IO ()
checkPackageDbEnvVar = do
hasGPP <- (getEnv "GHC_PACKAGE_PATH" >> return True)
`catchIO` (\_ -> return False)
when hasGPP $
die $ "Use of GHC's environment variable GHC_PACKAGE_PATH is "
++ "incompatible with Cabal. Use the flag --package-db to specify a "
++ "package database (it can be used multiple times)."
checkPackageDbEnvVar =
Internal.checkPackageDbEnvVar "GHC" "GHC_PACKAGE_PATH"
checkPackageDbStack :: PackageDBStack -> IO ()
checkPackageDbStack (GlobalPackageDB:rest)
......
......@@ -22,7 +22,8 @@ module Distribution.Simple.GHC.Internal (
ghcLookupProperty,
getHaskellObjects,
mkGhcOptPackages,
substTopDir
substTopDir,
checkPackageDbEnvVar
) where
import Distribution.Simple.GHC.ImplInfo ( GhcImplInfo (..) )
......@@ -63,9 +64,11 @@ import Language.Haskell.Extension
import qualified Data.Map as M
import Data.Char ( isSpace )
import Data.Maybe ( fromMaybe, maybeToList )
import Data.Maybe ( fromMaybe, maybeToList, isJust )
import Control.Monad ( unless, when )
import Data.Monoid ( Monoid(..) )
import System.Directory ( getDirectoryContents, getTemporaryDirectory )
import System.Environment ( getEnv )
import System.FilePath ( (</>), (<.>), takeExtension, takeDirectory )
import System.IO ( hClose, hPutStrLn )
......@@ -448,3 +451,27 @@ substTopDir topDir ipo
where f ('$':'t':'o':'p':'d':'i':'r':rest) = topDir ++ rest
f x = x
-- Cabal does not use the environment variable GHC{,JS}_PACKAGE_PATH; let
-- users know that this is the case. See ticket #335. Simply ignoring it is
-- not a good idea, since then ghc and cabal are looking at different sets
-- of package DBs and chaos is likely to ensue.
--
-- An exception to this is when running cabal from within a `cabal exec`
-- environment. In this case, `cabal exec` will set the
-- CABAL_SANDBOX_PACKAGE_PATH to the same value that it set
-- GHC{,JS}_PACKAGE_PATH to. If that is the case it is OK to allow
-- GHC{,JS}_PACKAGE_PATH.
checkPackageDbEnvVar :: String -> String -> IO ()
checkPackageDbEnvVar compilerName packagePathEnvVar = do
mPP <- lookupEnv packagePathEnvVar
when (isJust mPP) $ do
mcsPP <- lookupEnv "CABAL_SANDBOX_PACKAGE_PATH"
unless (mPP == mcsPP) abort
where
lookupEnv :: String -> IO (Maybe String)
lookupEnv name = (Just `fmap` getEnv name) `catchIO` const (return Nothing)
abort =
die $ "Use of " ++ compilerName ++ "'s environment variable "
++ packagePathEnvVar ++ " is incompatible with Cabal. Use the "
++ "flag --package-db to specify a package database (it can be "
++ "used multiple times)."
......@@ -76,7 +76,6 @@ import System.Directory ( doesFileExist )
import System.FilePath ( (</>), (<.>), takeExtension,
takeDirectory, replaceExtension,
splitExtension )
import System.Environment (getEnv)
import Distribution.Compat.Exception (catchIO)
configure :: Verbosity -> Maybe FilePath -> Maybe FilePath
......@@ -243,13 +242,8 @@ toPackageIndex verbosity pkgss conf = do
Just ghcjsProg = lookupProgram ghcjsProgram conf
checkPackageDbEnvVar :: IO ()
checkPackageDbEnvVar = do
hasGPP <- (getEnv "GHCJS_PACKAGE_PATH" >> return True)
`catchIO` (\_ -> return False)
when hasGPP $
die $ "Use of GHCJS' environment variable GHCJS_PACKAGE_PATH is "
++ "incompatible with Cabal. Use the flag --package-db to specify a "
++ "package database (it can be used multiple times)."
checkPackageDbEnvVar =
Internal.checkPackageDbEnvVar "GHCJS" "GHCJS_PACKAGE_PATH"
checkPackageDbStack :: PackageDBStack -> IO ()
checkPackageDbStack (GlobalPackageDB:rest)
......
......@@ -14,6 +14,7 @@ module Distribution.Client.Exec ( exec
import qualified Distribution.Simple.GHC as GHC
import qualified Distribution.Simple.GHCJS as GHCJS
import Distribution.Client.Sandbox (getSandboxConfigFilePath)
import Distribution.Client.Sandbox.PackageEnvironment (sandboxPackageDBPath)
import Distribution.Client.Sandbox.Types (UseSandbox (..))
......@@ -30,6 +31,7 @@ import Distribution.Verbosity (Verbosity)
import System.FilePath (searchPathSeparator, (</>))
import Control.Applicative ((<$>))
import Data.Monoid (mempty)
import Data.Traversable as T
......@@ -78,10 +80,15 @@ sandboxEnvironment verbosity sandboxDir comp platform programDb =
GHCJS -> env GHCJS.getGlobalPackageDB ghcjsProgram "GHCJS_PACKAGE_PATH"
_ -> die "exec only works with GHC and GHCJS"
where
env getGlobalPackageDB hcProgram overrideEnvVar = do
env getGlobalPackageDB hcProgram packagePathEnvVar = do
let Just program = lookupProgram hcProgram programDb
gDb <- getGlobalPackageDB verbosity program
return [(overrideEnvVar, hcPackagePath gDb)]
sandboxConfigFilePath <- getSandboxConfigFilePath mempty
let compilerPackagePath = hcPackagePath gDb
return [ (packagePathEnvVar, compilerPackagePath)
, ("CABAL_SANDBOX_PACKAGE_PATH", compilerPackagePath)
, ("CABAL_SANDBOX_CONFIG", Just sandboxConfigFilePath)
]
hcPackagePath gDb =
let s = sandboxPackageDBPath sandboxDir comp platform
......
......@@ -91,7 +91,21 @@ tests paths =
-- , testCase "can find executables built from the package" $ do
-- , testCase "configures cabal to use the sandbox" $ do
, testCase "configures cabal to use the sandbox" $ do
let libNameAndVersion = "my-0.1"
cleanPreviousBuilds paths
assertPackageInstall paths
assertMyLibIsNotAvailableOutsideofSandbox paths libNameAndVersion
result <- cabal_exec paths dir ["bash", "--", "-c", "cd subdir ; cabal sandbox hc-pkg list"]
assertExecSucceeded result
let output = outputText result
errMsg = "my library should have been found"
assertBool errMsg $
libNameAndVersion `isInfixOf` (intercalate " " . lines $ output)
]
cleanPreviousBuilds :: TestsPaths -> IO ()
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment