1 files changed, 36 insertions, 7 deletions

diff --git a/src/wrapper.hs b/src/wrapper.hs
index dab77358..6b24a368 100644
--- a/src/wrapper.hs
+++ b/src/wrapper.hs
@@ -6,6 +6,9 @@
 -- 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, it instead builds and runs in the
+-- current working directory.
 
 module Main where
 
@@ -14,31 +17,57 @@ import Propellor.Message
 import Propellor.Bootstrap
 import Utility.Monad
 import Utility.Directory
+import Utility.FileMode
 import Utility.Process
 import Utility.Process.NonConcurrent
 
 import System.Environment (getArgs)
 import System.Exit
-import System.Posix.Directory
+import System.Posix
 import Control.Monad.IfElse
 
 main :: IO ()
 main = withConcurrentOutput $ go =<< getArgs
   where
 	go ["--init"] = interactiveInit
-	go args = ifM (doesDirectoryExist =<< dotPropellor)
-		( do
-			checkRepoUpToDate
-			buildRunConfig args
-		, error "Seems that ~/.propellor/ does not exist. To set it up, run: propellor --init"
+	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
-	changeWorkingDirectory =<< dotPropellor
 	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 return True
+	, return False
+	)
+  where
+	unsafe s = error $ "Not using ./config.hs because " ++ s ++ ". This seems unsafe."