summaryrefslogtreecommitdiff
path: root/src/wrapper.hs
blob: 20b4d8c67f7c5e65026a1d294c2314b11511ca89 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
-- | 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 Main 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

main :: IO ()
main = 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"