Merge branch 'joeyconfig'

2 files changed, 40 insertions, 8 deletions

diff --git a/src/Propellor/Git.hs b/src/Propellor/Git.hs
index a4418340..a2f5aef2 100644
--- a/src/Propellor/Git.hs
+++ b/src/Propellor/Git.hs
@@ -29,17 +29,31 @@ setRepoUrl url = do
 	void $ boolSystem "git" [Param "config", Param (branchval "remote"), Param "origin"]
 	void $ boolSystem "git" [Param "config", Param (branchval "merge"), Param $ "refs/heads/"++branch]
 
+getGitConfigValue :: String -> IO (Maybe String)
+getGitConfigValue key = do
+	value <- catchMaybeIO $
+		takeWhile (/= '\n')
+			<$> readProcess "git" ["config", key]
+	return $ case value of
+		Just v | not (null v) -> Just v
+		_ -> Nothing
+
+-- `git config --bool propellor.blah` outputs "false" if propellor.blah is unset
+-- i.e. the git convention is that the default value of any git-config setting
+-- is "false".  So we don't need a Maybe Bool here.
+getGitConfigBool :: String -> IO Bool
+getGitConfigBool key = do
+	value <- catchMaybeIO $
+		takeWhile (/= '\n')
+			<$> readProcess "git" ["config", "--bool", key]
+	return $ case value of
+		Just "true" -> True
+		_ -> False
+
 getRepoUrl :: IO (Maybe String)
-getRepoUrl = getM get urls
+getRepoUrl = getM getGitConfigValue urls
   where
 	urls = ["remote.deploy.url", "remote.origin.url"]
-	get u = do
-		v <- catchMaybeIO $ 
-			takeWhile (/= '\n') 
-				<$> readProcess "git" ["config", u]
-		return $ case v of
-			Just url | not (null url) -> Just url
-			_ -> Nothing
 
 hasOrigin :: IO Bool
 hasOrigin = catchDefaultIO False $ do
diff --git a/src/Propellor/Spin.hs b/src/Propellor/Spin.hs
index ae7e7af5..bda146cc 100644
--- a/src/Propellor/Spin.hs
+++ b/src/Propellor/Spin.hs
@@ -32,6 +32,24 @@ import Utility.SafeCommand
 
 commitSpin :: IO ()
 commitSpin = do
+	-- safety check #1: check we're on the configured spin branch
+	spinBranch <- getGitConfigValue "propellor.spin-branch"
+	case spinBranch of
+		Nothing -> return () -- just a noop
+		Just b -> do
+			currentBranch <- getCurrentBranch
+			when (b /= currentBranch) $
+				error ("spin aborted: check out "
+ 					++ b ++ " branch first")
+
+	-- safety check #2: check we can commit with a dirty tree
+	noDirtySpin <- getGitConfigBool "propellor.forbid-dirty-spin"
+	when noDirtySpin $ do
+		status <- takeWhile (/= '\n')
+			<$> readProcess "git" ["status", "--porcelain"]
+		when (not . null $ status) $
+			error "spin aborted: commit changes first"
+
 	void $ actionMessage "Git commit" $
 		gitCommit (Just spinCommitMessage) 
 			[Param "--allow-empty", Param "-a"]