Merge branch 'joeyconfig'

4 files changed, 54 insertions, 9 deletions

diff --git a/debian/changelog b/debian/changelog
index 88a8543b..1f3706f5 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,10 @@
+propellor (2.15.1) UNRELEASED; urgency=medium
+
+  * Added git configs propellor.spin-branch and propellor.forbid-dirty-spin.
+    Thanks, Sean Whitton.
+
+ -- Joey Hess <id@joeyh.name>  Tue, 08 Dec 2015 11:59:43 -0400
+
 propellor (2.15.0) unstable; urgency=medium
 
   * Added UncheckedProperty type, along with unchecked to indicate a
diff --git a/doc/usage.mdwn b/doc/usage.mdwn
index 4eed5416..16e559fa 100644
--- a/doc/usage.mdwn
+++ b/doc/usage.mdwn
@@ -105,7 +105,7 @@ and configured in haskell.
 
 * propellor --check
 
-  If propellor is able to run, this simply exists successfully.
+  If propellor is able to run, this simply exits successfully.
 
 * propellor hostname
 
@@ -124,6 +124,12 @@ other debugging information.
 `git config propellor.debug 1` will configure propellor to output debugging
 information.
 
+`git config propellor.spin-branch foo` will configure propellor to refuse to
+spin when the foo branch is not checked out.
+
+`git config propellor.forbid-dirty-spin true` will configure propellor to refuse
+to spin when there are uncommitted changes in the `~/.propellor` repository.
+
 The usual git configuration controls which centralized repository (if any)
 propellor pushes and pulls from. 
 
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"]