summaryrefslogtreecommitdiff
path: root/src/Propellor/Wrapper.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Propellor/Wrapper.hs')
-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"