-- | This module is used to implement a wrapper program for propellor
-- distribution.
--
-- Distributions should install this program into PATH.
--
-- 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 :: IO ()
runWrapper = forall (m :: * -> *) a. (MonadIO m, MonadMask m) => m a -> m a
withConcurrentOutput forall a b. (a -> b) -> a -> b
$ do
	IO ()
useFileSystemEncoding
	[String] -> IO ()
go forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO [String]
getArgs
  where
	go :: [String] -> IO ()
go [String
"--init"] = IO ()
interactiveInit
	go [String]
args = forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM IO Bool
configInCurrentWorkingDirectory
		( [String] -> IO ()
buildRunConfig [String]
args
		, forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (String -> IO Bool
doesDirectoryExist forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO String
dotPropellor)
			( do
				IO ()
checkRepoUpToDate
				String -> IO ()
changeWorkingDirectory forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO String
dotPropellor
				[String] -> IO ()
buildRunConfig [String]
args
			, forall a. HasCallStack => String -> a
error String
"Seems that ~/.propellor/ does not exist. To set it up, run: propellor --init"
			)
		)

buildRunConfig :: [String] -> IO ()
buildRunConfig :: [String] -> IO ()
buildRunConfig [String]
args = do
	forall {m :: * -> *}. Monad m => m Bool -> m () -> m ()
unlessM (String -> IO Bool
doesFileExist String
"propellor") forall a b. (a -> b) -> a -> b
$ do
		Maybe Host -> IO ()
buildPropellor forall a. Maybe a
Nothing
		String -> IO ()
putStrLn String
""
		String -> IO ()
putStrLn String
""
	(Maybe Handle
_, Maybe Handle
_, Maybe Handle
_, ProcessHandle
pid) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcessNonConcurrent (String -> [String] -> CreateProcess
proc String
"./propellor" [String]
args) 
	forall a. ExitCode -> IO a
exitWith forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProcessHandle -> IO ExitCode
waitForProcessNonConcurrent ProcessHandle
pid

configInCurrentWorkingDirectory :: IO Bool
configInCurrentWorkingDirectory :: IO Bool
configInCurrentWorkingDirectory = forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (String -> IO Bool
doesFileExist String
"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.)
		FileStatus
s <- String -> IO FileStatus
getFileStatus String
"."
		UserID
uid <- IO UserID
getRealUserID
		if FileStatus -> UserID
fileOwner FileStatus
s forall a. Eq a => a -> a -> Bool
/= UserID
uid
			then forall {a}. String -> a
unsafe String
"you don't own the current directory"
			else if FileMode -> FileMode -> Bool
checkMode FileMode
groupWriteMode (FileStatus -> FileMode
fileMode FileStatus
s)
				then forall {a}. String -> a
unsafe String
"the current directory is group writable"
				else if FileMode -> FileMode -> Bool
checkMode FileMode
otherWriteMode (FileStatus -> FileMode
fileMode FileStatus
s)
					then forall {a}. String -> a
unsafe String
"the current directory is world-writable"
					else forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM IO Bool
mentionspropellor
						( forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
						, forall {a}. String -> a
notusing String
"it does not seem to be a propellor config file"
						)
	, forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
	)
  where
	unsafe :: String -> a
unsafe String
s = forall {a}. String -> a
notusing (String
s forall a. [a] -> [a] -> [a]
++ String
". This seems unsafe.")
	notusing :: String -> a
notusing String
s = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Not using ./config.hs because " forall a. [a] -> [a] -> [a]
++ String
s
	mentionspropellor :: IO Bool
mentionspropellor = (String
"Propellor" forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf`) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
readFile String
"config.hs"