summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorJoey Hess2014-11-23 18:48:52 -0400
committerJoey Hess2014-11-23 18:48:52 -0400
commit9d975e9ee4c44782da0815fb161ea8676dbf559c (patch)
treeb74c1037324cdc4308c98e475202649bf91e27df /src
parentbaba668033f86b7c91f6b15c58002ea4bdbf3da2 (diff)
add --merge
Diffstat (limited to 'src')
-rw-r--r--src/Propellor/CmdLine.hs3
-rw-r--r--src/Propellor/Git.hs7
-rw-r--r--src/Propellor/Gpg.hs14
-rw-r--r--src/Propellor/Spin.hs32
-rw-r--r--src/Propellor/Types.hs1
5 files changed, 49 insertions, 8 deletions
diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index 4a0ac613..3e375c7e 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -29,6 +29,7 @@ usage h = hPutStrLn h $ unlines
, " propellor --dump field context"
, " propellor --edit field context"
, " propellor --list-fields"
+ , " propellor --merge"
]
usageError :: [String] -> IO a
@@ -49,6 +50,7 @@ processCmdLine = go =<< getArgs
go ("--dump":f:c:[]) = withprivfield f c Dump
go ("--edit":f:c:[]) = withprivfield f c Edit
go ("--list-fields":[]) = return ListFields
+ go ("--merge":[]) = return Merge
go ("--help":_) = do
usage stdout
exitFailure
@@ -98,6 +100,7 @@ defaultMain hostlist = do
go _ (GitPush fin fout) = gitPushHelper fin fout
go _ (Update Nothing) = forceConsole >> fetchFirst (onlyprocess (update Nothing))
go _ (Update (Just h)) = forceConsole >> fetchFirst (update (Just h))
+ go _ Merge = mergeSpin
go True cmdline@(Spin _ _) = buildFirst cmdline $ go False cmdline
go True cmdline = updateFirst cmdline $ go False cmdline
go False (Spin hs r) = do
diff --git a/src/Propellor/Git.hs b/src/Propellor/Git.hs
index ccf97b94..34bc43e2 100644
--- a/src/Propellor/Git.hs
+++ b/src/Propellor/Git.hs
@@ -10,8 +10,13 @@ getCurrentBranch :: IO String
getCurrentBranch = takeWhile (/= '\n')
<$> readProcess "git" ["symbolic-ref", "--short", "HEAD"]
+getCurrentBranchRef :: IO String
+getCurrentBranchRef = takeWhile (/= '\n')
+ <$> readProcess "git" ["symbolic-ref", "HEAD"]
+
getCurrentGitSha1 :: String -> IO String
-getCurrentGitSha1 branchref = readProcess "git" ["show-ref", "--hash", branchref]
+getCurrentGitSha1 branchref = takeWhile (/= '\n')
+ <$> readProcess "git" ["show-ref", "--hash", branchref]
setRepoUrl :: String -> IO ()
setRepoUrl "" = return ()
diff --git a/src/Propellor/Gpg.hs b/src/Propellor/Gpg.hs
index 572be190..86f84dc1 100644
--- a/src/Propellor/Gpg.hs
+++ b/src/Propellor/Gpg.hs
@@ -83,14 +83,18 @@ addKey keyid = exitBool =<< allM (uncurry actionMessage)
, Param "propellor addkey"
]
+-- Adds --gpg-sign if there's a keyring.
+gpgSignParams :: [CommandParam] -> IO [CommandParam]
+gpgSignParams ps = ifM (doesFileExist keyring)
+ ( return (ps ++ [Param "--gpg-sign"])
+ , return ps
+ )
+
-- Automatically sign the commit if there'a a keyring.
gitCommit :: [CommandParam] -> IO Bool
gitCommit ps = do
- k <- doesFileExist keyring
- boolSystem "git" $ catMaybes $
- [ Just (Param "commit")
- , if k then Just (Param "--gpg-sign") else Nothing
- ] ++ map Just ps
+ ps' <- gpgSignParams ps
+ boolSystem "git" (Param "commit" : ps')
gpgDecrypt :: FilePath -> IO String
gpgDecrypt f = ifM (doesFileExist f)
diff --git a/src/Propellor/Spin.hs b/src/Propellor/Spin.hs
index 8606013a..9e8e145f 100644
--- a/src/Propellor/Spin.hs
+++ b/src/Propellor/Spin.hs
@@ -2,7 +2,8 @@ module Propellor.Spin (
commitSpin,
spin,
update,
- gitPushHelper
+ gitPushHelper,
+ mergeSpin,
) where
import Data.List
@@ -27,7 +28,7 @@ import Utility.SafeCommand
commitSpin :: IO ()
commitSpin = do
void $ actionMessage "Git commit" $
- gitCommit [Param "--allow-empty", Param "-a", Param "-m", Param "propellor spin"]
+ gitCommit [Param "--allow-empty", Param "-a", Param "-m", Param spinCommitMessage]
-- Push to central origin repo first, if possible.
-- The remote propellor will pull from there, which avoids
-- us needing to send stuff directly to the remote host.
@@ -269,3 +270,30 @@ gitPushHelper hin hout = void $ fromstdin `concurrently` tostdout
B.hPut toh b
hFlush toh
connect fromh toh
+
+mergeSpin :: IO ()
+mergeSpin = do
+ branch <- getCurrentBranch
+ branchref <- getCurrentBranchRef
+ old_head <- getCurrentGitSha1 branch
+ old_commit <- findLastNonSpinCommit
+ rungit "reset" [Param old_commit]
+ rungit "commit" [Param "-a"]
+ rungit "merge" =<< gpgSignParams [Param "-s", Param "ours", Param old_head]
+ current_commit <- getCurrentGitSha1 branch
+ rungit "update-ref" [Param branchref, Param current_commit]
+ rungit "checkout" [Param branch]
+ where
+ rungit cmd ps = unlessM (boolSystem "git" (Param cmd:ps)) $
+ error ("git " ++ cmd ++ " failed")
+
+findLastNonSpinCommit :: IO String
+findLastNonSpinCommit = do
+ commits <- map (separate (== ' ')) . lines
+ <$> readProcess "git" ["log", "--oneline", "--no-abbrev-commit"]
+ case dropWhile (\(_, msg) -> msg == spinCommitMessage) commits of
+ ((sha, _):_) -> return sha
+ _ -> error $ "Did not find any previous commit that was not a " ++ show spinCommitMessage
+
+spinCommitMessage :: String
+spinCommitMessage = "propellor spin"
diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
index 92b18cde..2f51b3e4 100644
--- a/src/Propellor/Types.hs
+++ b/src/Propellor/Types.hs
@@ -149,6 +149,7 @@ data CmdLine
| Edit PrivDataField Context
| ListFields
| AddKey String
+ | Merge
| Serialized CmdLine
| Continue CmdLine
| Update (Maybe HostName)