Merge branch 'joeyconfig'

This commit is contained in:
Joey Hess 2014-11-23 18:49:33 -04:00
commit f14749c1cc
7 changed files with 67 additions and 8 deletions

2
debian/changelog vendored
View File

@ -15,6 +15,8 @@ propellor (1.1.0) UNRELEASED; urgency=medium
* hasSomePassword and hasPassword now default to using the name of the
host as the Context for the password. To specify a different context,
use hasSomePassword' and hasPassword' (API change)
* Add --merge, to combine multiple --spin commits into a single, more useful
commit.
-- Joey Hess <joeyh@debian.org> Sat, 22 Nov 2014 00:12:35 -0400

View File

@ -65,6 +65,22 @@ action as needed to satisfy the configured properties of the local host.
Opens $EDITOR on the privdata value.
* --merge
Combine multiple --spin commits into a single, more useful commit.
When using propellor, you may find yourself repeatedly running
`propellor --spin` until you get things working the way you like.
This results in a lot of git commits being made, with incremental
changes.
To clean that up to a single commit, use `propellor --merge`. A normal
interactive git commit will then be made, consisting of all changes
that have been previously committed by --spin, since the last time a
normal git commit was made.
(This will result in a trapezoid pattern in gitk.)
* hostname
When run with a hostname and no other options, propellor will

View File

@ -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

View File

@ -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 ()

View File

@ -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)

View File

@ -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"

View File

@ -149,6 +149,7 @@ data CmdLine
| Edit PrivDataField Context
| ListFields
| AddKey String
| Merge
| Serialized CmdLine
| Continue CmdLine
| Update (Maybe HostName)