cadey
/
propellor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

avoid double-build in --spin 

It was fetching from the central repo, then building that, and then running
the client-to-client git update, and the building after that.

Remove the first build, as all that linking does take time.
This commit is contained in:
Joey Hess 2014-11-19 21:00:14 -04:00
parent 2ceace6bd5
commit 025c7c4b8e
2 changed files with 35 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
src/Propellor/CmdLine.hs
View File

@ -87,6 +87,7 @@ defaultMain hostlist = do
go _ (DockerChain hn s) = withhost hn $ Docker.chain s
go _ (DockerInit hn) = Docker.init hn
go _ (GitPush fin fout) = gitPushHelper fin fout
go _ (Update _) = forceConsole >> fetchFirst (onlyprocess update)
go True cmdline@(Spin _) = buildFirst cmdline $ go False cmdline
go True cmdline = updateFirst cmdline $ go False cmdline
go False (Spin hn) = withhost hn $ spin hn
@ -96,9 +97,6 @@ defaultMain hostlist = do
( onlyprocess $ withhost hn mainProperties
, go True (Spin hn)
)
go False (Update _) = do
forceConsole
onlyprocess update
withhost :: HostName -> (Host -> IO ()) -> IO ()
withhost hn a = maybe (unknownhost hn hostlist) a (findHost hostlist hn)
@ -127,35 +125,23 @@ buildFirst cmdline next = do
where
getmtime = catchMaybeIO $ getModificationTime "propellor"
fetchFirst :: IO () -> IO ()
fetchFirst next = do
whenM hasOrigin $
void fetchOrigin
next
updateFirst :: CmdLine -> IO () -> IO ()
updateFirst cmdline next = ifM hasOrigin (updateFirst' cmdline next, next)
updateFirst' :: CmdLine -> IO () -> IO ()
updateFirst' cmdline next = do
branchref <- getCurrentBranch
let originbranch = "origin" </> branchref
void $ actionMessage "Git fetch" $ boolSystem "git" [Param "fetch"]
oldsha <- getCurrentGitSha1 branchref
whenM (doesFileExist keyring) $
ifM (verifyOriginBranch originbranch)
( do
putStrLn $ "git branch " ++ originbranch ++ " gpg signature verified; merging"
hFlush stdout
void $ boolSystem "git" [Param "merge", Param originbranch]
, warningMessage $ "git branch " ++ originbranch ++ " is not signed with a trusted gpg key; refusing to deploy it! (Running with previous configuration instead.)"
)
newsha <- getCurrentGitSha1 branchref
if oldsha == newsha
then next
else ifM (actionMessage "Propellor build" $ boolSystem "make" [Param "build"])
( void $ boolSystem "./propellor" [Param "--continue", Param (show cmdline)]
updateFirst' cmdline next = ifM fetchOrigin
( ifM (actionMessage "Propellor build" $ boolSystem "make" [Param "build"])
( void $ boolSystem "./propellor" [Param "--continue", Param (show cmdline)]
, errorMessage "Propellor build failed!"
)
)
, next
)
spin :: HostName -> Host -> IO ()
spin hn hst = do

22
src/Propellor/Git.hs
View File

@ -62,3 +62,25 @@ verifyOriginBranch originbranch = do
nukeFile $ privDataDir </> "pubring.gpg"
nukeFile $ privDataDir </> "gpg.conf"
return (s == "U\n" || s == "G\n")
-- Returns True if HEAD is changed by fetching and merging from origin.
fetchOrigin :: IO Bool
fetchOrigin = do
branchref <- getCurrentBranch
let originbranch = "origin" </> branchref
void $ actionMessage "Git fetch" $ boolSystem "git" [Param "fetch"]
oldsha <- getCurrentGitSha1 branchref
whenM (doesFileExist keyring) $
ifM (verifyOriginBranch originbranch)
( do
putStrLn $ "git branch " ++ originbranch ++ " gpg signature verified; merging"
hFlush stdout
void $ boolSystem "git" [Param "merge", Param originbranch]
, warningMessage $ "git branch " ++ originbranch ++ " is not signed with a trusted gpg key; refusing to deploy it! (Running with previous configuration instead.)"
)
newsha <- getCurrentGitSha1 branchref
return $ oldsha /= newsha