summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorJoey Hess2015-12-08 12:00:39 -0400
committerJoey Hess2015-12-08 12:00:39 -0400
commitf11c4835d5952d885c678a49501b1dcc524316ad (patch)
treeb86635b1bd1bdffe530d4f3b7529cf6c564676b3 /src
parent5ecb4944a637c4f28a15746b2ea716850e63a5ab (diff)
parent39c0073d2800e23b051188de239efdea9b17793e (diff)
Merge branch 'joeyconfig'
Diffstat (limited to 'src')
-rw-r--r--src/Propellor/Git.hs30
-rw-r--r--src/Propellor/Spin.hs18
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"]