From af7b2d61c0c7f9b4fe53d8f5d18b5426a93cbd7b Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 27 Mar 2016 22:10:48 -0400 Subject: add dep on concurrent-output, and re-enable -O0 Using the external concurrent-output library lets it be built with -O2 as is needed to get good runtime memory use. Enabling -O0 because ghc is using rather a lot more time and memory due to the new more complex types. old master branch: Linking dist/build/propellor-config/propellor-config ... 24.59user 0.97system 0:25.93elapsed 98%CPU (0avgtext+0avgdata 354612maxresident)k 1544inputs+46064outputs (0major+371244minor)pagefaults 0swaps this branch before -O0: Linking dist/build/propellor-config/propellor-config ... 25.56user 0.73system 0:26.61elapsed 98%CPU (0avgtext+0avgdata 345348maxresident)k 0inputs+43480outputs (0major+364163minor)pagefaults 0swaps this branch with -O0: Linking dist/build/propellor-config/propellor-config ... 11.91user 0.75system 0:12.97elapsed 97%CPU (0avgtext+0avgdata 237472maxresident)k 16inputs+37264outputs (0major+336166minor)pagefaults 0swaps Above benchmarks are building all source files needed by config-simple.hs. The story is rather worse for joeyconfig.hs; building it now needs over 500 mb even with -O0 :-/ --- src/Propellor/Bootstrap.hs | 1 + 1 file changed, 1 insertion(+) (limited to 'src/Propellor/Bootstrap.hs') diff --git a/src/Propellor/Bootstrap.hs b/src/Propellor/Bootstrap.hs index 69eee66c..3b4c3106 100644 --- a/src/Propellor/Bootstrap.hs +++ b/src/Propellor/Bootstrap.hs @@ -90,6 +90,7 @@ depsCommand msys = "( " ++ intercalate " ; " (concat [osinstall, cabalinstall]) , "libghc-exceptions-dev" , "libghc-stm-dev" , "libghc-text-dev" + , "libghc-concurrent-output-dev" , "make" ] fbsddeps = -- cgit v1.2.3 From 29d8b616ea2dca958f8785266e33fac63cebcf46 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 30 Mar 2016 12:23:31 -0400 Subject: add hs-concurrent-output to freebsd deps --- src/Propellor/Bootstrap.hs | 1 + 1 file changed, 1 insertion(+) (limited to 'src/Propellor/Bootstrap.hs') diff --git a/src/Propellor/Bootstrap.hs b/src/Propellor/Bootstrap.hs index 3b4c3106..2ad0f688 100644 --- a/src/Propellor/Bootstrap.hs +++ b/src/Propellor/Bootstrap.hs @@ -109,6 +109,7 @@ depsCommand msys = "( " ++ intercalate " ; " (concat [osinstall, cabalinstall]) , "hs-exceptions" , "hs-stm" , "hs-text" + , "hs-concurrent-output" , "gmake" ] -- cgit v1.2.3 From 0f410f8acdb9e0b84ae364e80e5ee63adcb2ee50 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 30 Mar 2016 15:18:39 -0400 Subject: When new dependencies are added to propellor or the propellor config, try harder to get them installed. In particular, this makes propellor --spin work when the remote host needs to get dependencies installed in order to build the updated config. Fixes http://propellor.branchable.com/todo/problem_with_spin_after_new_dependencies_added/ --- debian/changelog | 4 ++++ src/Propellor/Bootstrap.hs | 33 ++++++++++++++++++++++++--------- src/Propellor/CmdLine.hs | 30 +++++++++++++++--------------- src/wrapper.hs | 2 +- 4 files changed, 44 insertions(+), 25 deletions(-) (limited to 'src/Propellor/Bootstrap.hs') diff --git a/debian/changelog b/debian/changelog index 1075773d..abc7d530 100644 --- a/debian/changelog +++ b/debian/changelog @@ -60,6 +60,10 @@ propellor (3.0.0) UNRELEASED; urgency=medium * Re-enabled -O0 in propellor.cabal to reign in ghc's memory use handling these complex new types. * Added dependency on concurrent-output; removed embedded copy. + * When new dependencies are added to propellor or the propellor config, + try harder to get them installed. In particular, this makes + propellor --spin work when the remote host needs to get dependencies + installed in order to build the updated config. -- Joey Hess Thu, 24 Mar 2016 15:02:33 -0400 diff --git a/src/Propellor/Bootstrap.hs b/src/Propellor/Bootstrap.hs index 2ad0f688..b60dd8c4 100644 --- a/src/Propellor/Bootstrap.hs +++ b/src/Propellor/Bootstrap.hs @@ -6,6 +6,7 @@ module Propellor.Bootstrap ( ) where import Propellor.Base +import Propellor.Types.Info import System.Posix.Files import Data.List @@ -130,22 +131,27 @@ installGitCommand msys = case msys of , "DEBIAN_FRONTEND=noninteractive apt-get --no-install-recommends --no-upgrade -y install git" ] -buildPropellor :: IO () -buildPropellor = unlessM (actionMessage "Propellor build" build) $ +buildPropellor :: Maybe Host -> IO () +buildPropellor mh = unlessM (actionMessage "Propellor build" (build msys)) $ errorMessage "Propellor build failed!" + where + msys = case fmap (fromInfo . hostInfo) mh of + Just (InfoVal sys) -> Just sys + _ -> Nothing -- Build propellor using cabal, and symlink propellor to where cabal -- leaves the built binary. -- -- For speed, only runs cabal configure when it's not been run before. -- If the build fails cabal may need to have configure re-run. -build :: IO Bool -build = catchBoolIO $ do - make "dist/setup-config" ["propellor.cabal"] $ - cabal ["configure"] - unlessM (cabal ["build", "propellor-config"]) $ do - void $ cabal ["configure"] - unlessM (cabal ["build"]) $ +-- +-- If the cabal configure fails, and a System is provided, installs +-- dependencies and retries. +build :: Maybe System -> IO Bool +build msys = catchBoolIO $ do + make "dist/setup-config" ["propellor.cabal"] cabal_configure + unlessM cabal_build $ + unlessM (cabal_configure <&&> cabal_build) $ error "cabal build failed" -- For safety against eg power loss in the middle of the build, -- make a copy of the binary, and move it into place atomically. @@ -165,6 +171,15 @@ build = catchBoolIO $ do cabalbuiltbin = "dist/build/propellor-config/propellor-config" safetycopy = cabalbuiltbin ++ ".built" tmpfor f = f ++ ".propellortmp" + cabal_configure = ifM (cabal ["configure"]) + ( return True + , case msys of + Nothing -> return False + Just sys -> + boolSystem "sh" [Param "-c", Param (depsCommand (Just sys))] + <&&> cabal ["configure"] + ) + cabal_build = cabal ["build", "propellor-config"] make :: FilePath -> [FilePath] -> IO Bool -> IO () make dest srcs builder = do diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index ee057d05..8fd2bf18 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -114,20 +114,20 @@ defaultMain hostlist = withConcurrentOutput $ do go _ (DockerInit hn) = Docker.init hn go _ (GitPush fin fout) = gitPushHelper fin fout go cr (Relay h) = forceConsole >> - updateFirst cr (Update (Just h)) (update (Just h)) + updateFirst Nothing cr (Update (Just h)) (update (Just h)) go _ (Update Nothing) = forceConsole >> fetchFirst (onlyprocess (update Nothing)) go _ (Update (Just h)) = update (Just h) go _ Merge = mergeSpin - go cr cmdline@(Spin hs mrelay) = buildFirst cr cmdline $ do + go cr cmdline@(Spin hs mrelay) = buildFirst Nothing cr cmdline $ do unless (isJust mrelay) commitSpin forM_ hs $ \hn -> withhost hn $ spin mrelay hn go cr cmdline@(Run hn) = ifM ((==) 0 <$> getRealUserID) - ( updateFirst cr cmdline $ runhost hn + ( updateFirst (findHost hostlist hn) cr cmdline $ runhost hn , fetchFirst $ go cr (Spin [hn] Nothing) ) go cr cmdline@(SimpleRun hn) = forceConsole >> - fetchFirst (buildFirst cr cmdline (runhost hn)) + fetchFirst (buildFirst (findHost hostlist hn) cr cmdline (runhost hn)) -- When continuing after a rebuild, don't want to rebuild again. go _ (Continue cmdline) = go NoRebuild cmdline @@ -149,17 +149,17 @@ unknownhost h hosts = errorMessage $ unlines -- Builds propellor (when allowed) and if it looks like a new binary, -- re-execs it to continue. -- Otherwise, runs the IO action to continue. -buildFirst :: CanRebuild -> CmdLine -> IO () -> IO () -buildFirst CanRebuild cmdline next = do +buildFirst :: Maybe Host -> CanRebuild -> CmdLine -> IO () -> IO () +buildFirst h CanRebuild cmdline next = do oldtime <- getmtime - buildPropellor + buildPropellor h newtime <- getmtime if newtime == oldtime then next else continueAfterBuild cmdline where getmtime = catchMaybeIO $ getModificationTime "propellor" -buildFirst NoRebuild _ next = next +buildFirst _ NoRebuild _ next = next continueAfterBuild :: CmdLine -> IO a continueAfterBuild cmdline = go =<< boolSystem "./propellor" @@ -176,23 +176,23 @@ fetchFirst next = do void fetchOrigin next -updateFirst :: CanRebuild -> CmdLine -> IO () -> IO () -updateFirst canrebuild cmdline next = ifM hasOrigin - ( updateFirst' canrebuild cmdline next +updateFirst :: Maybe Host -> CanRebuild -> CmdLine -> IO () -> IO () +updateFirst h canrebuild cmdline next = ifM hasOrigin + ( updateFirst' h canrebuild cmdline next , next ) -- If changes can be fetched from origin, Builds propellor (when allowed) -- and re-execs the updated propellor binary to continue. -- Otherwise, runs the IO action to continue. -updateFirst' :: CanRebuild -> CmdLine -> IO () -> IO () -updateFirst' CanRebuild cmdline next = ifM fetchOrigin +updateFirst' :: Maybe Host -> CanRebuild -> CmdLine -> IO () -> IO () +updateFirst' h CanRebuild cmdline next = ifM fetchOrigin ( do - buildPropellor + buildPropellor h continueAfterBuild cmdline , next ) -updateFirst' NoRebuild _ next = next +updateFirst' _ NoRebuild _ next = next -- Gets the fully qualified domain name, given a string that might be -- a short name to look up in the DNS. diff --git a/src/wrapper.hs b/src/wrapper.hs index a204b60c..289b12b5 100644 --- a/src/wrapper.hs +++ b/src/wrapper.hs @@ -99,7 +99,7 @@ wrapper args propellordir propellorbin = do warnoutofdate propellordir True buildruncfg = do changeWorkingDirectory propellordir - buildPropellor + buildPropellor Nothing putStrLn "" putStrLn "" chain -- cgit v1.2.3 From b3b49ad53db956e5de43fd6b7ef785f026740f2e Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 30 Mar 2016 15:40:57 -0400 Subject: apt install propellor dependencies more quietly Avoids spam when most deps are installed --- src/Propellor/Bootstrap.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src/Propellor/Bootstrap.hs') diff --git a/src/Propellor/Bootstrap.hs b/src/Propellor/Bootstrap.hs index b60dd8c4..969e1a42 100644 --- a/src/Propellor/Bootstrap.hs +++ b/src/Propellor/Bootstrap.hs @@ -71,7 +71,7 @@ depsCommand msys = "( " ++ intercalate " ; " (concat [osinstall, cabalinstall]) , "cabal install --only-dependencies" ] - aptinstall p = "DEBIAN_FRONTEND=noninteractive apt-get --no-upgrade --no-install-recommends -y install " ++ p + aptinstall p = "DEBIAN_FRONTEND=noninteractive apt-get -qq --no-upgrade --no-install-recommends -y install " ++ p pkginstall p = "ASSUME_ALWAYS_YES=yes pkg install " ++ p -- This is the same deps listed in debian/control. @@ -128,7 +128,7 @@ installGitCommand msys = case msys of use cmds = "if ! git --version >/dev/null; then " ++ intercalate " && " cmds ++ "; fi" apt = [ "apt-get update" - , "DEBIAN_FRONTEND=noninteractive apt-get --no-install-recommends --no-upgrade -y install git" + , "DEBIAN_FRONTEND=noninteractive apt-get -qq --no-install-recommends --no-upgrade -y install git" ] buildPropellor :: Maybe Host -> IO () -- cgit v1.2.3 From e3920861ee444945e54fd42ce0f599d585155652 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 2 Apr 2016 01:29:23 -0400 Subject: Stack support. * Stack support. "git config propellor.buildsystem stack" will make propellor build its config using stack. * When propellor is installed using stack, propellor --init will automatically set propellor.buildsystem=stack. --- Makefile | 1 + debian/changelog | 4 ++ ...use___96__GHC__95__PACKAGE__95__PATH__96__.mdwn | 6 +++ propellor.cabal | 6 +++ src/Propellor/Bootstrap.hs | 54 ++++++++++++++++++---- src/Propellor/DotDir.hs | 47 +++++++++++++++---- stack.yaml | 6 +++ 7 files changed, 107 insertions(+), 17 deletions(-) create mode 100644 stack.yaml (limited to 'src/Propellor/Bootstrap.hs') diff --git a/Makefile b/Makefile index a9ad2b84..5322d6c5 100644 --- a/Makefile +++ b/Makefile @@ -16,6 +16,7 @@ install: mkdir -p dist/gittmp $(CABAL) sdist cat dist/propellor-*.tar.gz | (cd dist/gittmp && tar zx --strip-components=1) + cp stack.yaml dist/gittmp # also include in bundle # cabal sdist does not preserve symlinks, so copy over file cd dist/gittmp && for f in $$(find -type f); do rm -f $$f; cp -a ../../$$f $$f; done # reset mtime on files in git bundle so bundle is reproducible diff --git a/debian/changelog b/debian/changelog index ae593902..aab077b0 100644 --- a/debian/changelog +++ b/debian/changelog @@ -68,6 +68,10 @@ propellor (3.0.0) UNRELEASED; urgency=medium walk the user through setting up ~/.propellor, with a choice between a clone of propellor's git repository, or a minimal config, and will configure propellor to use a gpg key. + * Stack support. "git config propellor.buildsystem stack" will make + propellor build its config using stack. + * When propellor is installed using stack, propellor --init will + automatically set propellor.buildsystem=stack. -- Joey Hess Wed, 30 Mar 2016 15:45:08 -0400 diff --git a/doc/todo/detect_and_use___96__GHC__95__PACKAGE__95__PATH__96__.mdwn b/doc/todo/detect_and_use___96__GHC__95__PACKAGE__95__PATH__96__.mdwn index 2973e662..55c3ef7e 100644 --- a/doc/todo/detect_and_use___96__GHC__95__PACKAGE__95__PATH__96__.mdwn +++ b/doc/todo/detect_and_use___96__GHC__95__PACKAGE__95__PATH__96__.mdwn @@ -7,3 +7,9 @@ and run with stack exec -- propellor ... see [[https://github.com/yesodweb/yesod/issues/1018]] and [[https://github.com/yesodweb/yesod/commit/a7cccf2a7c5df8b26da9ea4fdcb6bac5ab3a3b75]] + +> I don't think `stack exec propellor` makes sense to use. +> Instead, `stack install propellor` and then put that in PATH. +> I've now made `propellor --init` know when it was built using stack, +> and it will set up propellor to continue to build itself using stack. +> [[done]] --[[Joey]] diff --git a/propellor.cabal b/propellor.cabal index d97d4096..3431d410 100644 --- a/propellor.cabal +++ b/propellor.cabal @@ -34,6 +34,10 @@ Description: . It is configured using haskell. +Flag UseStack + Description: Have propellor rebuild itself using Stack (default is Cabal) + Default: False + Executable propellor Main-Is: wrapper.hs GHC-Options: -threaded -Wall -fno-warn-tabs -O0 @@ -46,6 +50,8 @@ Executable propellor unix, unix-compat, ansi-terminal, containers (>= 0.5), network, async, time, mtl, transformers, exceptions (>= 0.6), stm, text, concurrent-output + if flag(UseStack) + CPP-Options: -DUSE_STACK Executable propellor-config Main-Is: config.hs diff --git a/src/Propellor/Bootstrap.hs b/src/Propellor/Bootstrap.hs index 969e1a42..300be156 100644 --- a/src/Propellor/Bootstrap.hs +++ b/src/Propellor/Bootstrap.hs @@ -7,6 +7,7 @@ module Propellor.Bootstrap ( import Propellor.Base import Propellor.Types.Info +import Propellor.Git.Config import System.Posix.Files import Data.List @@ -139,16 +140,22 @@ buildPropellor mh = unlessM (actionMessage "Propellor build" (build msys)) $ Just (InfoVal sys) -> Just sys _ -> Nothing --- Build propellor using cabal, and symlink propellor to where cabal --- leaves the built binary. --- +-- Build propellor using cabal or stack, and symlink propellor to the +-- built binary. +build :: Maybe System -> IO Bool +build msys = catchBoolIO $ do + bs <- getGitConfigValue "propellor.buildsystem" + case bs of + Just "stack" -> stackBuild msys + _ -> cabalBuild msys + -- For speed, only runs cabal configure when it's not been run before. -- If the build fails cabal may need to have configure re-run. -- -- If the cabal configure fails, and a System is provided, installs -- dependencies and retries. -build :: Maybe System -> IO Bool -build msys = catchBoolIO $ do +cabalBuild :: Maybe System -> IO Bool +cabalBuild msys = do make "dist/setup-config" ["propellor.cabal"] cabal_configure unlessM cabal_build $ unlessM (cabal_configure <&&> cabal_build) $ @@ -163,14 +170,11 @@ build msys = catchBoolIO $ do unlessM (boolSystem "cp" [Param "-af", Param cabalbuiltbin, Param (tmpfor safetycopy)]) $ error "cp of binary failed" rename (tmpfor safetycopy) safetycopy - createSymbolicLink safetycopy (tmpfor dest) - rename (tmpfor dest) dest + symlinkPropellorBin safetycopy return True where - dest = "propellor" cabalbuiltbin = "dist/build/propellor-config/propellor-config" safetycopy = cabalbuiltbin ++ ".built" - tmpfor f = f ++ ".propellortmp" cabal_configure = ifM (cabal ["configure"]) ( return True , case msys of @@ -181,6 +185,35 @@ build msys = catchBoolIO $ do ) cabal_build = cabal ["build", "propellor-config"] +stackBuild :: Maybe System -> IO Bool +stackBuild _msys = do + createDirectoryIfMissing True builddest + ifM (stack buildparams) + ( do + symlinkPropellorBin (builddest "propellor-config") + return True + , return False + ) + where + builddest = ".built" + buildparams = + [ "--local-bin-path", builddest + , "build" + , ":propellor-config" -- only build config program + , "--copy-bins" + ] + +-- Atomic symlink creation/update. +symlinkPropellorBin :: FilePath -> IO () +symlinkPropellorBin bin = do + createSymbolicLink bin (tmpfor dest) + rename (tmpfor dest) dest + where + dest = "propellor" + +tmpfor :: FilePath -> FilePath +tmpfor f = f ++ ".propellortmp" + make :: FilePath -> [FilePath] -> IO Bool -> IO () make dest srcs builder = do dt <- getmtime dest @@ -193,3 +226,6 @@ make dest srcs builder = do cabal :: [String] -> IO Bool cabal = boolSystem "cabal" . map Param + +stack :: [String] -> IO Bool +stack = boolSystem "stack" . map Param diff --git a/src/Propellor/DotDir.hs b/src/Propellor/DotDir.hs index f0dace2f..90147abe 100644 --- a/src/Propellor/DotDir.hs +++ b/src/Propellor/DotDir.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + module Propellor.DotDir where import Propellor.Message @@ -11,9 +13,12 @@ import Utility.Process import Utility.SafeCommand import Utility.Exception import Utility.Path +-- This module is autogenerated by the build system. +import qualified Paths_propellor as Package import Data.Char import Data.List +import Data.Version import Control.Monad import Control.Monad.IfElse import System.Directory @@ -48,6 +53,15 @@ dotPropellor = do home <- myHomeDir return (home ".propellor") +data InitCfg = UseCabal | UseStack + +initCfg :: InitCfg +#ifdef USE_STACK +initCfg = UseStack +#else +initCfg = UseCabal +#endif + interactiveInit :: IO () interactiveInit = ifM (doesDirectoryExist =<< dotPropellor) ( error "~/.propellor/ already exists, not doing anything" @@ -95,7 +109,7 @@ section = do putStrLn "" setup :: IO () -setup = do +setup initcfg = do putStrLn "Propellor's configuration file is ~/.propellor/config.hs" putStrLn "" putStrLn "Lets get you started with a simple config that you can adapt" @@ -103,14 +117,21 @@ setup = do putStrLn " A: A clone of propellor's git repository (most flexible)" putStrLn " B: The bare minimum files to use propellor (most simple)" prompt "Which would you prefer?" - [ ("A", actionMessage "Cloning propellor's git repository" fullClone >> return ()) - , ("B", actionMessage "Creating minimal config" minimalConfig >> return ()) + [ ("A", void $ actionMessage "Cloning propellor's git repository" fullClone) + , ("B", void $ actionMessage "Creating minimal config" minimalConfig) ] changeWorkingDirectory =<< dotPropellor section putStrLn "Let's try building the propellor configuration, to make sure it will work..." putStrLn "" + void $ boolSystem "git" + [ Param "config" + , Param "propellor.buildsystem" + , Param $ case initCfg of + UseCabal -> "cabal" + UseStack -> "stack" + ] buildPropellor Nothing putStrLn "" putStrLn "Great! Propellor is bootstrapped." @@ -197,15 +218,16 @@ minimalConfig :: IO Result minimalConfig = do d <- dotPropellor createDirectoryIfMissing True d - let cabalfile = d "config.cabal" - let configfile = d "config.hs" - writeFile cabalfile (unlines cabalcontent) - writeFile configfile (unlines configcontent) changeWorkingDirectory d void $ boolSystem "git" [Param "init"] - void $ boolSystem "git" [Param "add" , File cabalfile, File configfile] + addfile "config.cabal" cabalcontent + addfile "config.hs" configcontent + addfile "stack.yaml" stackcontent return MadeChange where + addfile f content = do + writeFile f (unlines content) + void $ boolSystem "git" [Param "add" , File f] cabalcontent = [ "-- This is a cabal file to use to build your propellor configuration." , "" @@ -252,6 +274,15 @@ minimalConfig = do , " & Cron.runPropellor (Cron.Times \"30 * * * *\")" , "" ] + stackcontent = + -- This should be the same resolver version in propellor's + -- own stack.yaml + [ "resolver: lts-5.10" + , "packages:" + , "- '.'" + , "extra-deps:" + , "- propellor-" ++ showVersion Package.version + ] fullClone :: IO Result fullClone = do diff --git a/stack.yaml b/stack.yaml new file mode 100644 index 00000000..6b5e859c --- /dev/null +++ b/stack.yaml @@ -0,0 +1,6 @@ +resolver: lts-5.10 +packages: +- '.' +flags: + propellor: + usestack: true -- cgit v1.2.3