summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Propellor/CmdLine.hs40
-rw-r--r--src/Propellor/Git.hs22
2 files changed, 35 insertions, 27 deletions
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