summaryrefslogtreecommitdiff
path: root/Propellor
diff options
context:
space:
mode:
authorJoey Hess2014-03-31 16:20:38 -0400
committerJoey Hess2014-03-31 16:20:38 -0400
commit740a8243f604d178f0874a4c9409c008d03371c4 (patch)
tree6b5fff437e7e07063e3483f306acb6bd08df1daa /Propellor
parenta5b739af6d20312d47ab75a63bc4fbfd847b65a6 (diff)
propellor spin
Diffstat (limited to 'Propellor')
-rw-r--r--Propellor/CmdLine.hs36
1 files changed, 33 insertions, 3 deletions
diff --git a/Propellor/CmdLine.hs b/Propellor/CmdLine.hs
index bd69528e..4af4bd77 100644
--- a/Propellor/CmdLine.hs
+++ b/Propellor/CmdLine.hs
@@ -48,9 +48,9 @@ usage = do
defaultMain :: (HostName -> Maybe [Property]) -> IO ()
defaultMain getprops = go =<< processCmdLine
where
- go (Run host) = withprops host ensureProperties
- go (Spin host) = withprops host (const $ spin host)
- go (Boot host) = withprops host boot
+ go (Run host) = withprops host $ pullFirst . ensureProperties
+ go (Spin host) = withprops host $ const $ spin host
+ go (Boot host) = withprops host $ pullFirst . boot
go (Set host field) = setPrivData host field
go (AddKey keyid) = addKey keyid
withprops host a = maybe (unknownhost host) a (getprops host)
@@ -61,6 +61,36 @@ unknownhost h = error $ unwords
, "(perhaps you should specify the real hostname on the command line?)"
]
+pullFirst :: IO () -> IO ()
+pullFirst next = do
+ branchref <- takeWhile (/= '\n')
+ <$> readProcess "git" ["symbolic-ref", "HEAD"]
+ let originbranch = "origin" </> takeFileName branchref
+ void $ boolSystem "git" [Param "fetch"]
+
+ whenM (doesFileExist keyring) $ do
+ {- To verify origin/master commit's signature, have to
+ - convince gpg to use our keyring. While running git log.
+ - Which has no way to pass options to gpg.
+ - Argh! -}
+ let gpgconf = privDataDir </> "gpg.conf"
+ writeFile gpgconf $ unlines
+ [ " keyring " ++ keyring
+ , "no-auto-check-trustdb"
+ ]
+ -- gpg is picky about perms
+ modifyFileMode privDataDir (removeModes otherGroupModes)
+ s <- readProcessEnv "git" ["log", "-n", "1", "--format=%G?", originbranch]
+ (Just [("GNUPGHOME", privDataDir)])
+ nukeFile $ privDataDir </> "trustring.gpg"
+ nukeFile $ privDataDir </> "gpg.conf"
+ when (s /= "U\n" && s/= "G\n") $
+ error $ "git branch" ++ originbranch ++ " is not signed with a trusted gpg key; refusing to deploy it!"
+
+ void $ boolSystem "git" [Param "merge", Param originbranch]
+
+ next
+
spin :: HostName -> IO ()
spin host = do
url <- getUrl