From 025c7c4b8e0b7aa3ba3ff8c077c5fbef3c8fa63d Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 19 Nov 2014 21:00:14 -0400 Subject: 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. --- src/Propellor/CmdLine.hs | 40 +++++++++++++--------------------------- src/Propellor/Git.hs | 22 ++++++++++++++++++++++ 2 files changed, 35 insertions(+), 27 deletions(-) (limited to 'src') diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs index 725bae43..e42e2408 100644 --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -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 diff --git a/src/Propellor/Git.hs b/src/Propellor/Git.hs index 51ed3df2..88d5c3ab 100644 --- a/src/Propellor/Git.hs +++ b/src/Propellor/Git.hs @@ -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 -- cgit v1.2.3