summaryrefslogtreecommitdiff
path: root/src/Propellor
diff options
context:
space:
mode:
authorJoey Hess2018-04-22 12:15:35 -0400
committerJoey Hess2018-04-22 12:19:40 -0400
commitd8d2faece72eabd18c2ff303e5fb63c3a69961f6 (patch)
treee4fba26d18e3db8b52a94d80aff21413b642c67d /src/Propellor
parent57ec3e2451ad7dfa70d4a1b522259e0036e3e6f2 (diff)
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')
-rw-r--r--src/Propellor/Wrapper.hs85
1 files changed, 85 insertions, 0 deletions
diff --git a/src/Propellor/Wrapper.hs b/src/Propellor/Wrapper.hs
new file mode 100644
index 00000000..f399b2cf
--- /dev/null
+++ b/src/Propellor/Wrapper.hs
@@ -0,0 +1,85 @@
+-- | This module is used to implement a wrapper program for propellor
+-- distribution.
+--
+-- 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 Propellor.DotDir
+import Propellor.Message
+import Propellor.Bootstrap
+import Utility.Monad
+import Utility.Directory
+import Utility.FileMode
+import Utility.Process
+import Utility.Process.NonConcurrent
+import Utility.FileSystemEncoding
+
+import System.Environment (getArgs)
+import System.Exit
+import System.Posix
+import Data.List
+import Control.Monad.IfElse
+import Control.Applicative
+import Prelude
+
+runWrapper :: IO ()
+runWrapper = withConcurrentOutput $ do
+ useFileSystemEncoding
+ go =<< getArgs
+ where
+ go ["--init"] = interactiveInit
+ go args = ifM configInCurrentWorkingDirectory
+ ( buildRunConfig args
+ , ifM (doesDirectoryExist =<< dotPropellor)
+ ( do
+ checkRepoUpToDate
+ 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
+ )
+ where
+ unsafe s = notusing (s ++ ". This seems unsafe.")
+ notusing s = error $ "Not using ./config.hs because " ++ s
+ mentionspropellor = ("Propellor" `isInfixOf`) <$> readFile "config.hs"