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 = IO () -> IO ()
forall (m :: * -> *) a. (MonadIO m, MonadMask m) => m a -> m a
withConcurrentOutput (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
IO ()
useFileSystemEncoding
[[Char]] -> IO ()
go ([[Char]] -> IO ()) -> IO [[Char]] -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO [[Char]]
getArgs
where
go :: [[Char]] -> IO ()
go [[Char]
"--init"] = IO ()
interactiveInit
go [[Char]]
args = IO Bool -> (IO (), IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM IO Bool
configInCurrentWorkingDirectory
( [[Char]] -> IO ()
buildRunConfig [[Char]]
args
, IO Bool -> (IO (), IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM ([Char] -> IO Bool
doesDirectoryExist ([Char] -> IO Bool) -> IO [Char] -> IO Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO [Char]
dotPropellor)
( do
IO ()
checkRepoUpToDate
[Char] -> IO ()
changeWorkingDirectory ([Char] -> IO ()) -> IO [Char] -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO [Char]
dotPropellor
[[Char]] -> IO ()
buildRunConfig [[Char]]
args
, [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"Seems that ~/.propellor/ does not exist. To set it up, run: propellor --init"
)
)
buildRunConfig :: [String] -> IO ()
buildRunConfig :: [[Char]] -> IO ()
buildRunConfig [[Char]]
args = do
IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM ([Char] -> IO Bool
doesFileExist [Char]
"propellor") (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Maybe Host -> IO ()
buildPropellor Maybe Host
forall a. Maybe a
Nothing
[Char] -> IO ()
putStrLn [Char]
""
[Char] -> IO ()
putStrLn [Char]
""
(Maybe Handle
_, Maybe Handle
_, Maybe Handle
_, ProcessHandle
pid) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcessNonConcurrent ([Char] -> [[Char]] -> CreateProcess
proc [Char]
"./propellor" [[Char]]
args)
ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith (ExitCode -> IO ()) -> IO ExitCode -> IO ()
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 = IO Bool -> (IO Bool, IO Bool) -> IO Bool
forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM ([Char] -> IO Bool
doesFileExist [Char]
"config.hs")
( do
FileStatus
s <- [Char] -> IO FileStatus
getFileStatus [Char]
"."
UserID
uid <- IO UserID
getRealUserID
if FileStatus -> UserID
fileOwner FileStatus
s UserID -> UserID -> Bool
forall a. Eq a => a -> a -> Bool
/= UserID
uid
then [Char] -> IO Bool
forall a. [Char] -> a
unsafe [Char]
"you don't own the current directory"
else if FileMode -> FileMode -> Bool
checkMode FileMode
groupWriteMode (FileStatus -> FileMode
fileMode FileStatus
s)
then [Char] -> IO Bool
forall a. [Char] -> a
unsafe [Char]
"the current directory is group writable"
else if FileMode -> FileMode -> Bool
checkMode FileMode
otherWriteMode (FileStatus -> FileMode
fileMode FileStatus
s)
then [Char] -> IO Bool
forall a. [Char] -> a
unsafe [Char]
"the current directory is world-writable"
else IO Bool -> (IO Bool, IO Bool) -> IO Bool
forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM IO Bool
mentionspropellor
( Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
, [Char] -> IO Bool
forall a. [Char] -> a
notusing [Char]
"it does not seem to be a propellor config file"
)
, Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
)
where
unsafe :: [Char] -> a
unsafe [Char]
s = [Char] -> a
forall a. [Char] -> a
notusing ([Char]
s [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
". This seems unsafe.")
notusing :: [Char] -> a
notusing [Char]
s = [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [Char]
"Not using ./config.hs because " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s
mentionspropellor :: IO Bool
mentionspropellor = ([Char]
"Propellor" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf`) ([Char] -> Bool) -> IO [Char] -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO [Char]
readFile [Char]
"config.hs"