diff --git a/ChangeLog.md b/ChangeLog.md index 416ca03d..a41aa3b2 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,8 @@ +## 0.5.1 + +* `loadBuildConstraints` +* More command line options + ## 0.5.0 * Print "Still Alive" while checking, to avoid Travis timeouts diff --git a/Stackage/BuildConstraints.hs b/Stackage/BuildConstraints.hs index 674ac395..e7aae355 100644 --- a/Stackage/BuildConstraints.hs +++ b/Stackage/BuildConstraints.hs @@ -11,6 +11,8 @@ module Stackage.BuildConstraints , getSystemInfo , defaultBuildConstraints , toBC + , BuildConstraintsSource (..) + , loadBuildConstraints ) where import Control.Monad.Writer.Strict (execWriter, tell) @@ -22,7 +24,7 @@ import Distribution.System (Arch, OS) import qualified Distribution.System import Distribution.Version (anyVersion) import Filesystem (isFile) -import Network.HTTP.Client (Manager, httpLbs, responseBody) +import Network.HTTP.Client (Manager, httpLbs, responseBody, Request) import Stackage.CorePackages import Stackage.Prelude @@ -126,15 +128,32 @@ instance FromJSON PackageConstraints where -- Checks the current directory for a build-constraints.yaml file and uses it -- if present. If not, downloads from Github. defaultBuildConstraints :: Manager -> IO BuildConstraints -defaultBuildConstraints man = do - e <- isFile fp - if e - then decodeFileEither (fpToString fp) >>= either throwIO toBC - else httpLbs req man >>= - either throwIO toBC . decodeEither' . toStrict . responseBody +defaultBuildConstraints = loadBuildConstraints BCSDefault + +data BuildConstraintsSource + = BCSDefault + | BCSFile FilePath + | BCSWeb Request + deriving (Show) + +loadBuildConstraints :: BuildConstraintsSource -> Manager -> IO BuildConstraints +loadBuildConstraints bcs man = do + case bcs of + BCSDefault -> do + e <- isFile fp0 + if e + then loadFile fp0 + else loadReq req0 + BCSFile fp -> loadFile fp + BCSWeb req -> loadReq req where - fp = "build-constraints.yaml" - req = "https://raw.githubusercontent.com/fpco/stackage/master/build-constraints.yaml" + fp0 = "build-constraints.yaml" + req0 = "https://raw.githubusercontent.com/fpco/stackage/master/build-constraints.yaml" + + loadFile fp = decodeFileEither (fpToString fp) >>= either throwIO toBC + loadReq req = httpLbs req man >>= + either throwIO toBC . decodeEither' . toStrict . responseBody + getSystemInfo :: IO SystemInfo getSystemInfo = do diff --git a/Stackage/CompleteBuild.hs b/Stackage/CompleteBuild.hs index 7a96ce74..5960d960 100644 --- a/Stackage/CompleteBuild.hs +++ b/Stackage/CompleteBuild.hs @@ -27,6 +27,7 @@ import Stackage.Prelude import Stackage.ServerBundle import Stackage.UpdateBuildPlan import Stackage.Upload +import System.Environment (lookupEnv) import System.IO (BufferMode (LineBuffering), hSetBuffering) -- | Flags passed in from the command line. @@ -241,12 +242,18 @@ justUploadNightly day = do finallyUpload :: Settings -> Manager -> IO () finallyUpload settings@Settings{..} man = do putStrLn "Uploading bundle to Stackage Server" - token <- readFile "/auth-token" + + mtoken <- lookupEnv "STACKAGE_AUTH_TOKEN" + token <- + case mtoken of + Nothing -> decodeUtf8 <$> readFile "/auth-token" + Just token -> return $ pack token + now <- epochTime let ghcVer = display $ siGhcVersion $ bpSystemInfo plan (ident, mloc) <- flip uploadBundle man $ setArgs ghcVer def { ubContents = serverBundle now (title ghcVer) slug plan - , ubAuthToken = decodeUtf8 token + , ubAuthToken = token } putStrLn $ "New ident: " ++ unSnapshotIdent ident forM_ mloc $ \loc -> @@ -257,7 +264,7 @@ finallyUpload settings@Settings{..} man = do putStrLn "Uploading docs to Stackage Server" res1 <- uploadDocs UploadDocs { udServer = def - , udAuthToken = decodeUtf8 token + , udAuthToken = token , udDocs = pbDocDir pb , udSnapshot = ident } man @@ -274,7 +281,7 @@ finallyUpload settings@Settings{..} man = do putStrLn "Uploading doc map" uploadDocMap UploadDocMap { udmServer = def - , udmAuthToken = decodeUtf8 token + , udmAuthToken = token , udmSnapshot = ident , udmDocDir = pbDocDir pb , udmPlan = plan diff --git a/Stackage/PerformBuild.hs b/Stackage/PerformBuild.hs index 55601341..58821125 100644 --- a/Stackage/PerformBuild.hs +++ b/Stackage/PerformBuild.hs @@ -197,7 +197,7 @@ performBuild' pb@PerformBuild {..} = withBuildDir $ \builddir -> do id (\db -> (("HASKELL_PACKAGE_SANDBOX", fpToString db):)) (pbDatabase pb) - (map fixEnv env) + (filter allowedEnv $ map fixEnv env) , sbHaddockFiles = haddockFiles } @@ -215,6 +215,8 @@ performBuild' pb@PerformBuild {..} = withBuildDir $ \builddir -> do | toUpper p == "PATH" = (p, fpToString (pbBinDir pb) ++ pathSep : x) | otherwise = (p, x) + allowedEnv (k, _) = k `notMember` bannedEnvs + -- | Separate for the PATH environment variable pathSep :: Char #ifdef mingw32_HOST_OS @@ -223,6 +225,12 @@ performBuild' pb@PerformBuild {..} = withBuildDir $ \builddir -> do pathSep = ':' #endif +-- | Environment variables we don't allow to be passed on to child processes. +bannedEnvs :: Set String +bannedEnvs = setFromList + [ "STACKAGE_AUTH_TOKEN" + ] + data SingleBuild = SingleBuild { sbSem :: TSem , sbErrsVar :: TVar (Map PackageName BuildFailure)