From f86804fa27a2cf5b1972b14ab41e81edb85ad661 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 3 Jan 2016 16:56:00 -0400 Subject: refactor into smaller modules to untangle git and gpg modules --- src/Propellor/Git/VerifiedBranch.hs | 51 +++++++++++++++++++++++++++++++++++++ 1 file changed, 51 insertions(+) create mode 100644 src/Propellor/Git/VerifiedBranch.hs (limited to 'src/Propellor/Git/VerifiedBranch.hs') diff --git a/src/Propellor/Git/VerifiedBranch.hs b/src/Propellor/Git/VerifiedBranch.hs new file mode 100644 index 00000000..a39bc7e9 --- /dev/null +++ b/src/Propellor/Git/VerifiedBranch.hs @@ -0,0 +1,51 @@ +module Propellor.Git.VerifiedBranch where + +import Propellor.Base +import Propellor.Git +import Propellor.Gpg +import Propellor.PrivData.Paths +import Utility.FileMode + +{- To verify origin branch 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! + -} +verifyOriginBranch :: String -> IO Bool +verifyOriginBranch originbranch = do + 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 "trustdb.gpg" + 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 "Pull from central git repository" $ + 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