|author||Joey Hess||2018-04-22 12:15:35 -0400|
|committer||Joey Hess||2018-04-22 12:19:40 -0400|
separate Hs-Source-Dirs for binaries
This is a trick I only just learned about, see https://stackoverflow.com/questions/6711151/how-to-avoid-recompiling-in-this-cabal-file#6711739 Significantly increased propellor build speed when your config.hs is in a fork of the propellor repository, by avoiding redundant builds of propellor library. Also avoids needing to list all the build deps 3 times. Also avoids cabal 2.x wanting every module to be listed 3 times. Note that the bulk of wrapper.hs had to move into the propellor library, since that code depended on stuff not exposed by the library. This commit was sponsored by Henrik Riomar on Patreon.
Diffstat (limited to 'src/Propellor')
1 files changed, 85 insertions, 0 deletions
diff --git a/src/Propellor/Wrapper.hs b/src/Propellor/Wrapper.hs
new file mode 100644
@@ -0,0 +1,85 @@
+-- | This module is used to implement a wrapper program for propellor
+-- Distributions should install this program into PATH.
+-- (Cabal builds it as dist/build/propellor/propellor).
+-- This is not the propellor main program (that's config.hs).
+-- This bootstraps ~/.propellor/config.hs, builds it if
+-- it's not already built, and runs it.
+-- If ./config.hs exists and looks like a propellor config file,
+-- it instead builds and runs in the current working directory.
+module Propellor.Wrapper (runWrapper) where
+import System.Environment (getArgs)
+runWrapper :: IO ()
+runWrapper = withConcurrentOutput $ do
+ go =<< getArgs
+ go ["--init"] = interactiveInit
+ go args = ifM configInCurrentWorkingDirectory
+ ( buildRunConfig args
+ , ifM (doesDirectoryExist =<< dotPropellor)
+ ( do
+ changeWorkingDirectory =<< dotPropellor
+ buildRunConfig args
+ , error "Seems that ~/.propellor/ does not exist. To set it up, run: propellor --init"
+buildRunConfig :: [String] -> IO ()
+buildRunConfig args = do
+ unlessM (doesFileExist "propellor") $ do
+ buildPropellor Nothing
+ putStrLn ""
+ putStrLn ""
+ (_, _, _, pid) <- createProcessNonConcurrent (proc "./propellor" args)
+ exitWith =<< waitForProcessNonConcurrent pid
+configInCurrentWorkingDirectory :: IO Bool
+configInCurrentWorkingDirectory = ifM (doesFileExist "config.hs")
+ ( do
+ -- This is a security check to avoid using the current
+ -- working directory as the propellor configuration
+ -- if it's not owned by the user, or is world-writable,
+ -- or group writable. (Some umasks may make directories
+ -- group writable, but typical ones do not.)
+ s <- getFileStatus "."
+ uid <- getRealUserID
+ if fileOwner s /= uid
+ then unsafe "you don't own the current directory"
+ else if checkMode groupWriteMode (fileMode s)
+ then unsafe "the current directory is group writable"
+ else if checkMode otherWriteMode (fileMode s)
+ then unsafe "the current directory is world-writable"
+ else ifM mentionspropellor
+ ( return True
+ , notusing "it does not seem to be a propellor config file"
+ , return False
+ unsafe s = notusing (s ++ ". This seems unsafe.")
+ notusing s = error $ "Not using ./config.hs because " ++ s
+ mentionspropellor = ("Propellor" `isInfixOf`) <$> readFile "config.hs"