diff --git a/ChangeLog.md b/ChangeLog.md index 9f84cbcb7d..73e03c1555 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -10,7 +10,12 @@ Behavior changes: Other enhancements: -* Add`support for `system-ghc` and `install-ghc` fields to `stack config set` command. +* Add support for `system-ghc` and `install-ghc` fields to `stack config set` command. +* Add `ghc-build` option to override autodetected GHC build to use (e.g. gmp4, + tinfo6, nopie) on Linux. +* `stack setup` detects systems where gcc enables PIE by default (such as Ubuntu + 16.10) and adjusts the GHC `configure` options accordingly. + [#2542](https://github.com/commercialhaskell/stack/issues/2542) Bug fixes: diff --git a/doc/yaml_configuration.md b/doc/yaml_configuration.md index 99163dcc47..4b00c5c83c 100644 --- a/doc/yaml_configuration.md +++ b/doc/yaml_configuration.md @@ -435,6 +435,14 @@ Specify a variant binary distribution of GHC to use. Known values: [setup-info](#setup-info) so `stack setup` knows where to download it, or pass the `stack setup --ghc-bindist` argument on the command-line +### ghc-build + +(Since 1.2.1) + +Specify a specialized architecture bindist to use. Normally this is +determined automatically, but you can override the autodetected value here. +Possible arguments include `standard`, `gmp4`, `tinfo6`, and `nopie`. + ### setup-info (Since 0.1.5) @@ -451,7 +459,7 @@ setup-info: url: "https://example.com/ghc-7.10.2-i386-unknown-mingw32-foo.tar.xz" ``` -`url` may be either URL or (since UNRELEASED) absolute file path. +`url` may be either URL or (since 1.2.0) absolute file path. ### pvp-bounds diff --git a/src/Stack/Config.hs b/src/Stack/Config.hs index 9080b67791..7a276e988f 100644 --- a/src/Stack/Config.hs +++ b/src/Stack/Config.hs @@ -227,6 +227,7 @@ configFromConfigMonoid configStackRoot configUserConfigPath mresolver mproject C configMonoidPackageIndices configGHCVariant0 = getFirst configMonoidGHCVariant + configGHCBuild = getFirst configMonoidGHCBuild configSystemGHC = fromFirst (isNothing configGHCVariant0) configMonoidSystemGHC configInstallGHC = fromFirst False configMonoidInstallGHC diff --git a/src/Stack/Options.hs b/src/Stack/Options.hs index 7382b88456..7bea0caf60 100644 --- a/src/Stack/Options.hs +++ b/src/Stack/Options.hs @@ -210,7 +210,7 @@ cleanOptsParser = CleanShallow <$> packages <|> doFullClean -- | Command-line arguments parser for configuration. configOptsParser :: GlobalOptsContext -> Parser ConfigMonoid configOptsParser hide0 = - (\stackRoot workDir buildOpts dockerOpts nixOpts systemGHC installGHC arch ghcVariant jobs includes libs overrideGccPath skipGHCCheck skipMsys localBin modifyCodePage allowDifferentUser -> mempty + (\stackRoot workDir buildOpts dockerOpts nixOpts systemGHC installGHC arch ghcVariant ghcBuild jobs includes libs overrideGccPath skipGHCCheck skipMsys localBin modifyCodePage allowDifferentUser -> mempty { configMonoidStackRoot = stackRoot , configMonoidWorkDir = workDir , configMonoidBuildOpts = buildOpts @@ -221,6 +221,7 @@ configOptsParser hide0 = , configMonoidSkipGHCCheck = skipGHCCheck , configMonoidArch = arch , configMonoidGHCVariant = ghcVariant + , configMonoidGHCBuild = ghcBuild , configMonoidJobs = jobs , configMonoidExtraIncludeDirs = includes , configMonoidExtraLibDirs = libs @@ -261,6 +262,7 @@ configOptsParser hide0 = <> hide )) <*> optionalFirst (ghcVariantParser (hide0 /= OuterGlobalOpts)) + <*> optionalFirst (ghcBuildParser (hide0 /= OuterGlobalOpts)) <*> optionalFirst (option auto ( long "jobs" <> short 'j' @@ -854,6 +856,23 @@ ghcVariantParser hide = Left e -> readerError (show e) Right v -> return v +-- | GHC build parser +ghcBuildParser :: Bool -> Parser CompilerBuild +ghcBuildParser hide = + option + readGHCBuild + (long "ghc-build" <> metavar "BUILD" <> + help + "Specialized GHC build, e.g. 'gmp4' or 'standard' (usually auto-detected)" <> + hideMods hide + ) + where + readGHCBuild = do + s <- readerAsk + case parseCompilerBuild s of + Left e -> readerError (show e) + Right v -> return v + -- | Parser for @solverCmd@ solverOptsParser :: Parser Bool solverOptsParser = boolFlags False diff --git a/src/Stack/Setup.hs b/src/Stack/Setup.hs index 0490d29e96..39fb968dc6 100644 --- a/src/Stack/Setup.hs +++ b/src/Stack/Setup.hs @@ -476,67 +476,85 @@ ensureCompiler sopts = do -- | Determine which GHC build to use dependong on which shared libraries are available -- on the system. getGhcBuild - :: (MonadIO m, MonadBaseControl IO m, MonadCatch m, MonadLogger m, HasPlatform env, MonadReader env m) + :: (MonadIO m, MonadBaseControl IO m, MonadCatch m, MonadLogger m, HasPlatform env, HasConfig env, MonadReader env m) => EnvOverride -> m CompilerBuild getGhcBuild menv = do - -- TODO: a more reliable, flexible, and data driven approach would be to actually download small - -- "test" executables (from setup-info) that link to the same gmp/tinfo versions - -- that GHC does (i.e. built in same environment as the GHC bindist). The algorithm would go - -- something like this: - -- - -- check for previous 'uname -a'/`ldconfig -p` plus compiler version/variant in cache - -- if cached, then use that as suffix - -- otherwise: - -- download setup-info - -- go through all with right prefix for os/version/variant - -- first try "standard" (no extra suffix), then the rest - -- download "compatibility check" exe if not already downloaded - -- try running it - -- if successful, then choose that - -- cache compiler suffix with the uname -a and ldconfig -p output hash plus compiler version - -- - -- Of course, could also try to make a static GHC bindist instead of all this rigamarole. - - platform <- asks getPlatform - case platform of - Platform _ Linux -> do - eldconfigOut <- tryProcessStdout Nothing menv "ldconfig" ["-p"] - let firstWords = case eldconfigOut of - Right ldconfigOut -> mapMaybe (headMay . T.words) $ - T.lines $ T.decodeUtf8With T.lenientDecode ldconfigOut - Left _ -> [] - checkLib lib - | libT `elem` firstWords = do - $logDebug ("Found shared library " <> libT <> " in 'ldconfig -p' output") - return True + config <- asks getConfig + case configGHCBuild config of + Just ghcBuild -> return ghcBuild + Nothing -> determineGhcBuild + where + determineGhcBuild = do + -- TODO: a more reliable, flexible, and data driven approach would be to actually download small + -- "test" executables (from setup-info) that link to the same gmp/tinfo versions + -- that GHC does (i.e. built in same environment as the GHC bindist). The algorithm would go + -- something like this: + -- + -- check for previous 'uname -a'/`ldconfig -p` plus compiler version/variant in cache + -- if cached, then use that as suffix + -- otherwise: + -- download setup-info + -- go through all with right prefix for os/version/variant + -- first try "standard" (no extra suffix), then the rest + -- download "compatibility check" exe if not already downloaded + -- try running it + -- if successful, then choose that + -- cache compiler suffix with the uname -a and ldconfig -p output hash plus compiler version + -- + -- Of course, could also try to make a static GHC bindist instead of all this rigamarole. + + platform <- asks getPlatform + case platform of + Platform _ Linux -> do + eldconfigOut <- tryProcessStdout Nothing menv "ldconfig" ["-p"] + egccErrOut <- tryProcessStderrStdout Nothing menv "gcc" ["-v"] + let firstWords = case eldconfigOut of + Right ldconfigOut -> mapMaybe (headMay . T.words) $ + T.lines $ T.decodeUtf8With T.lenientDecode ldconfigOut + Left _ -> [] + checkLib lib + | libT `elem` firstWords = do + $logDebug ("Found shared library " <> libT <> " in 'ldconfig -p' output") + return True #ifndef WINDOWS - -- (mkAbsDir "/usr/lib") fails to compile on Windows, thus the CPP - | otherwise = do - -- This is a workaround for the fact that libtinfo.so.6 doesn't appear in - -- the 'ldconfig -p' output on Arch even when it exists. - -- There doesn't seem to be an easy way to get the true list of directories - -- to scan for shared libs, but this works for our particular case. - e <- doesFileExist ($(mkAbsDir "/usr/lib") lib) - if e - then $logDebug ("Found shared library " <> libT <> " in /usr/lib") - else $logDebug ("Did not find shared library " <> libT) - return e + -- (mkAbsDir "/usr/lib") fails to compile on Windows, thus the CPP + | otherwise = do + -- This is a workaround for the fact that libtinfo.so.6 doesn't appear in + -- the 'ldconfig -p' output on Arch even when it exists. + -- There doesn't seem to be an easy way to get the true list of directories + -- to scan for shared libs, but this works for our particular case. + e <- doesFileExist ($(mkAbsDir "/usr/lib") lib) + if e + then $logDebug ("Found shared library " <> libT <> " in /usr/lib") + else $logDebug ("Did not find shared library " <> libT) + return e #endif - where - libT = T.pack (toFilePath lib) - hastinfo5 <- checkLib $(mkRelFile "libtinfo.so.5") - hastinfo6 <- checkLib $(mkRelFile "libtinfo.so.6") - hasncurses6 <- checkLib $(mkRelFile "libncursesw.so.6") - hasgmp5 <- checkLib $(mkRelFile "libgmp.so.10") - hasgmp4 <- checkLib $(mkRelFile "libgmp.so.3") - if | hastinfo5 && hasgmp5 -> useBuild CompilerBuildStandard - | hastinfo6 && hasgmp5 -> useBuild (CompilerBuildSpecialized "tinfo6") - | hasncurses6 && hasgmp5 -> useBuild (CompilerBuildSpecialized "ncurses6") - | hasgmp4 && hastinfo5 -> useBuild (CompilerBuildSpecialized "gmp4") - | otherwise -> useBuild CompilerBuildStandard - _ -> useBuild CompilerBuildStandard - where + where + libT = T.pack (toFilePath lib) + noPie = case egccErrOut of + Right (gccErr,gccOut) -> + "--enable-default-pie" `elem` (S8.words (gccOut <> gccErr)) + Left _ -> False + hastinfo5 <- checkLib $(mkRelFile "libtinfo.so.5") + hastinfo6 <- checkLib $(mkRelFile "libtinfo.so.6") + hasncurses6 <- checkLib $(mkRelFile "libncursesw.so.6") + hasgmp5 <- checkLib $(mkRelFile "libgmp.so.10") + hasgmp4 <- checkLib $(mkRelFile "libgmp.so.3") + let libComponents = + if | hastinfo5 && hasgmp5 -> [] + | hastinfo6 && hasgmp5 -> ["tinfo6"] + | hasncurses6 && hasgmp5 -> ["ncurses6"] + | hasgmp4 && hastinfo5 -> ["gmp4"] + | otherwise -> [] + pieComponents = + if noPie + then ["nopie"] + else [] + case (concat [libComponents, pieComponents]) of + [] -> useBuild CompilerBuildStandard + components -> useBuild (CompilerBuildSpecialized (intercalate "-" components)) + _ -> useBuild CompilerBuildStandard useBuild CompilerBuildStandard = do $logDebug "Using standard GHC build" return (CompilerBuildStandard) @@ -774,7 +792,7 @@ downloadAndInstallCompiler ghcBuild si wanted@GhcVersion{} versionCheck mbindist _ -> throwM RequireCustomGHCVariant case wanted of GhcVersion version -> - return (version, DownloadInfo (T.pack bindistURL) Nothing Nothing) + return (version, GHCDownloadInfo mempty mempty (DownloadInfo (T.pack bindistURL) Nothing Nothing)) _ -> throwM WantedMustBeGHC _ -> do @@ -786,7 +804,7 @@ downloadAndInstallCompiler ghcBuild si wanted@GhcVersion{} versionCheck mbindist let installer = case configPlatform config of Platform _ Cabal.Windows -> installGHCWindows selectedVersion - _ -> installGHCPosix selectedVersion + _ -> installGHCPosix selectedVersion downloadInfo $logInfo $ "Preparing to install GHC" <> (case ghcVariant of @@ -799,7 +817,7 @@ downloadAndInstallCompiler ghcBuild si wanted@GhcVersion{} versionCheck mbindist $logInfo "This will not interfere with any system-level installation." ghcPkgName <- parsePackageNameFromString ("ghc" ++ ghcVariantSuffix ghcVariant ++ compilerBuildSuffix ghcBuild) let tool = Tool $ PackageIdentifier ghcPkgName selectedVersion - downloadAndInstallTool (configLocalPrograms config) si downloadInfo tool installer + downloadAndInstallTool (configLocalPrograms config) si (gdiDownloadInfo downloadInfo) tool installer downloadAndInstallCompiler compilerBuild si wanted versionCheck _mbindistUrl = do config <- asks getConfig ghcVariant <- asks getGHCVariant @@ -905,13 +923,14 @@ data ArchiveType installGHCPosix :: (MonadIO m, MonadMask m, MonadLogger m, MonadReader env m, HasConfig env, HasHttpManager env, MonadBaseControl IO m, HasTerminal env) => Version + -> GHCDownloadInfo -> SetupInfo -> Path Abs File -> ArchiveType -> Path Abs Dir -> Path Abs Dir -> m () -installGHCPosix version _ archiveFile archiveType tempDir destDir = do +installGHCPosix version downloadInfo _ archiveFile archiveType tempDir destDir = do platform <- asks getPlatform menv0 <- getMinimalEnvOverride menv <- mkEnvOverride platform (removeHaskellEnvVars (unEnvOverride menv0)) @@ -942,8 +961,9 @@ installGHCPosix version _ archiveFile archiveType tempDir destDir = do parseRelDir $ "ghc-" ++ versionString version - let runStep step wd cmd args = do - result <- try (readProcessNull (Just wd) menv cmd args) + let runStep step wd env cmd args = do + menv' <- modifyEnvOverride menv (Map.union env) + result <- try (readProcessNull (Just wd) menv' cmd args) case result of Right _ -> return () Left ex -> do @@ -962,13 +982,16 @@ installGHCPosix version _ archiveFile archiveType tempDir destDir = do $logSticky $ T.concat ["Unpacking GHC into ", T.pack . toFilePath $ tempDir, " ..."] $logDebug $ "Unpacking " <> T.pack (toFilePath archiveFile) - runStep "unpacking" tempDir tarTool [compOpt : "xf", toFilePath archiveFile] + runStep "unpacking" tempDir mempty tarTool [compOpt : "xf", toFilePath archiveFile] $logSticky "Configuring GHC ..." - runStep "configuring" dir (toFilePath $ dir $(mkRelFile "configure")) ["--prefix=" ++ toFilePath destDir] + runStep "configuring" dir + (gdiConfigureEnv downloadInfo) + (toFilePath $ dir $(mkRelFile "configure")) + (("--prefix=" ++ toFilePath destDir) : map T.unpack (gdiConfigureOpts downloadInfo)) $logSticky "Installing GHC ..." - runStep "installing" dir makeTool ["install"] + runStep "installing" dir mempty makeTool ["install"] $logStickyDone $ "Installed GHC." $logDebug $ "GHC installed to " <> T.pack (toFilePath destDir) diff --git a/src/Stack/Types/Config.hs b/src/Stack/Types/Config.hs index f1e24040ca..a73dc5ccc7 100644 --- a/src/Stack/Types/Config.hs +++ b/src/Stack/Types/Config.hs @@ -48,6 +48,7 @@ module Stack.Types.Config ,CompilerBuild(..) ,compilerBuildName ,compilerBuildSuffix + ,parseCompilerBuild -- ** EnvConfig & HasEnvConfig ,EnvConfig(..) ,HasEnvConfig(..) @@ -148,6 +149,7 @@ module Stack.Types.Config -- ** Setup ,DownloadInfo(..) ,VersionedDownloadInfo(..) + ,GHCDownloadInfo(..) ,SetupInfo(..) ,SetupInfoLocation(..) -- ** Docker entrypoint @@ -258,6 +260,8 @@ data Config = -- ^ The variant of GHC requested by the user. -- In most cases, use 'BuildConfig' or 'MiniConfig's version instead, -- which will have an auto-detected default. + ,configGHCBuild :: !(Maybe CompilerBuild) + -- ^ Override build of the compiler distribution (e.g. standard, gmp4, tinfo6) ,configUrls :: !Urls -- ^ URLs for other files used by stack. -- TODO: Better document @@ -815,7 +819,9 @@ data ConfigMonoid = ,configMonoidArch :: !(First String) -- ^ Used for overriding the platform ,configMonoidGHCVariant :: !(First GHCVariant) - -- ^ Used for overriding the GHC variant + -- ^ Used for overriding the platform + ,configMonoidGHCBuild :: !(First CompilerBuild) + -- ^ Used for overriding the GHC build ,configMonoidJobs :: !(First Int) -- ^ See: 'configJobs' ,configMonoidExtraIncludeDirs :: !(Set (Path Abs Dir)) @@ -893,6 +899,7 @@ parseConfigMonoidJSON obj = do ..!= VersionRangeJSON anyVersion configMonoidArch <- First <$> obj ..:? configMonoidArchName configMonoidGHCVariant <- First <$> obj ..:? configMonoidGHCVariantName + configMonoidGHCBuild <- First <$> obj ..:? configMonoidGHCBuildName configMonoidJobs <- First <$> obj ..:? configMonoidJobsName configMonoidExtraIncludeDirs <- obj ..:? configMonoidExtraIncludeDirsName ..!= Set.empty configMonoidExtraLibDirs <- obj ..:? configMonoidExtraLibDirsName ..!= Set.empty @@ -985,6 +992,9 @@ configMonoidArchName = "arch" configMonoidGHCVariantName :: Text configMonoidGHCVariantName = "ghc-variant" +configMonoidGHCBuildName :: Text +configMonoidGHCBuildName = "ghc-build" + configMonoidJobsName :: Text configMonoidJobsName = "jobs" @@ -1563,8 +1573,16 @@ parseGHCVariant s = -- | Build of the compiler distribution (e.g. standard, gmp4, tinfo6) data CompilerBuild - = CompilerBuildStandard - | CompilerBuildSpecialized String + = CompilerBuildStandard + | CompilerBuildSpecialized String + deriving (Show) + +instance FromJSON CompilerBuild where + -- Strange structuring is to give consistent error messages + parseJSON = + withText + "CompilerBuild" + (either (fail . show) return . parseCompilerBuild . T.unpack) -- | Descriptive name for compiler build compilerBuildName :: CompilerBuild -> String @@ -1576,6 +1594,12 @@ compilerBuildSuffix :: CompilerBuild -> String compilerBuildSuffix CompilerBuildStandard = "" compilerBuildSuffix (CompilerBuildSpecialized s) = '-' : s +-- | Parse compiler build from a String. +parseCompilerBuild :: (MonadThrow m) => String -> m CompilerBuild +parseCompilerBuild "" = return CompilerBuildStandard +parseCompilerBuild "standard" = return CompilerBuildStandard +parseCompilerBuild name = return (CompilerBuildSpecialized name) + -- | Information for a file to download. data DownloadInfo = DownloadInfo { downloadInfoUrl :: Text @@ -1615,11 +1639,29 @@ instance FromJSON (WithJSONWarnings VersionedDownloadInfo) where , vdiDownloadInfo = downloadInfo } +data GHCDownloadInfo = GHCDownloadInfo + { gdiConfigureOpts :: [Text] + , gdiConfigureEnv :: Map Text Text + , gdiDownloadInfo :: DownloadInfo + } + deriving Show + +instance FromJSON (WithJSONWarnings GHCDownloadInfo) where + parseJSON = withObjectWarnings "GHCDownloadInfo" $ \o -> do + configureOpts <- o ..:? "configure-opts" ..!= mempty + configureEnv <- o ..:? "configure-env" ..!= mempty + downloadInfo <- parseDownloadInfoFromObject o + return GHCDownloadInfo + { gdiConfigureOpts = configureOpts + , gdiConfigureEnv = configureEnv + , gdiDownloadInfo = downloadInfo + } + data SetupInfo = SetupInfo { siSevenzExe :: Maybe DownloadInfo , siSevenzDll :: Maybe DownloadInfo , siMsys2 :: Map Text VersionedDownloadInfo - , siGHCs :: Map Text (Map Version DownloadInfo) + , siGHCs :: Map Text (Map Version GHCDownloadInfo) , siGHCJSs :: Map Text (Map CompilerVersion DownloadInfo) , siStack :: Map Text (Map Version DownloadInfo) } diff --git a/src/System/Process/Read.hs b/src/System/Process/Read.hs index 9291b442fe..b8e8b5f5c0 100644 --- a/src/System/Process/Read.hs +++ b/src/System/Process/Read.hs @@ -11,7 +11,9 @@ module System.Process.Read (readProcessStdout + ,readProcessStderrStdout ,tryProcessStdout + ,tryProcessStderrStdout ,sinkProcessStdout ,sinkProcessStderrStdout ,sinkProcessStderrStdoutHandle @@ -164,6 +166,17 @@ tryProcessStdout :: (MonadIO m, MonadLogger m, MonadBaseControl IO m, MonadCatch tryProcessStdout wd menv name args = try (readProcessStdout wd menv name args) +-- | Try to produce strict 'S.ByteString's from the stderr and stdout of a +-- process. +tryProcessStderrStdout :: (MonadIO m, MonadLogger m, MonadBaseControl IO m, MonadCatch m) + => Maybe (Path Abs Dir) -- ^ Optional directory to run in + -> EnvOverride + -> String -- ^ Command + -> [String] -- ^ Command line arguments + -> m (Either ReadProcessException (S.ByteString, S.ByteString)) +tryProcessStderrStdout wd menv name args = + try (readProcessStderrStdout wd menv name args) + -- | Produce a strict 'S.ByteString' from the stdout of a process. -- -- Throws a 'ReadProcessException' exception if the process fails. @@ -177,6 +190,19 @@ readProcessStdout wd menv name args = sinkProcessStdout wd menv name args CL.consume >>= liftIO . evaluate . S.concat +-- | Produce strict 'S.ByteString's from the stderr and stdout of a process. +-- +-- Throws a 'ReadProcessException' exception if the process fails. +readProcessStderrStdout :: (MonadIO m, MonadLogger m, MonadBaseControl IO m, MonadCatch m) + => Maybe (Path Abs Dir) -- ^ Optional directory to run in + -> EnvOverride + -> String -- ^ Command + -> [String] -- ^ Command line arguments + -> m (S.ByteString, S.ByteString) +readProcessStderrStdout wd menv name args = do + (e, o) <- sinkProcessStderrStdout wd menv name args CL.consume CL.consume + liftIO $ (,) <$> evaluate (S.concat e) <*> evaluate (S.concat o) + -- | An exception while trying to read from process. data ReadProcessException = ReadProcessException CreateProcess ExitCode L.ByteString L.ByteString