module Propellor.Git.VerifiedBranch where
import Propellor.Base
import Propellor.Git
import Propellor.PrivData.Paths
verifyOriginBranch :: String -> IO Bool
verifyOriginBranch :: String -> IO Bool
verifyOriginBranch String
originbranch = do
let gpgconf :: String
gpgconf = String
privDataDir String -> String -> String
</> String
"gpg.conf"
String
keyring <- IO String
privDataKeyring
String -> String -> IO ()
writeFile String
gpgconf (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
[ String
" keyring " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
keyring
, String
"no-auto-check-trustdb"
]
String -> (FileMode -> FileMode) -> IO ()
modifyFileMode String
privDataDir ([FileMode] -> FileMode -> FileMode
removeModes [FileMode]
otherGroupModes)
Bool
verified <- String -> [CommandParam] -> Maybe [(String, String)] -> IO Bool
boolSystemEnv String
"git" [String -> CommandParam
Param String
"verify-commit", String -> CommandParam
Param String
originbranch]
([(String, String)] -> Maybe [(String, String)]
forall a. a -> Maybe a
Just [(String
"GNUPGHOME", String
privDataDir)])
String -> IO ()
nukeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
privDataDir String -> String -> String
</> String
"trustdb.gpg"
String -> IO ()
nukeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
privDataDir String -> String -> String
</> String
"pubring.gpg"
String -> IO ()
nukeFile (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
privDataDir String -> String -> String
</> String
"gpg.conf"
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
verified
fetchOrigin :: IO Bool
fetchOrigin :: IO Bool
fetchOrigin = do
Bool
fetched <- String -> IO Bool -> IO Bool
forall (m :: * -> *) r.
(MonadIO m, MonadMask m, ActionResult r, ToResult r) =>
String -> m r -> m r
actionMessage String
"Pull from central git repository" (IO Bool -> IO Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$
String -> [CommandParam] -> IO Bool
boolSystem String
"git" [String -> CommandParam
Param String
"fetch"]
if Bool
fetched
then IO Bool
mergeOrigin
else Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
mergeOrigin :: IO Bool
mergeOrigin :: IO Bool
mergeOrigin = do
String
branchref <- IO String
getCurrentBranch
let originbranch :: String
originbranch = String
"origin" String -> String -> String
</> String
branchref
String
oldsha <- String -> IO String
getCurrentGitSha1 String
branchref
String
keyring <- IO String
privDataKeyring
IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (String -> IO Bool
doesFileExist String
keyring) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IO Bool -> (IO (), IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (String -> IO Bool
verifyOriginBranch String
originbranch)
( do
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"git branch " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
originbranch String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" gpg signature verified; merging"
Handle -> IO ()
hFlush Handle
stdout
IO Bool -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> [CommandParam] -> IO Bool
boolSystem String
"git" [String -> CommandParam
Param String
"merge", String -> CommandParam
Param String
originbranch]
, String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
warningMessage (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"git branch " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
originbranch String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is not signed with a trusted gpg key; refusing to deploy it! (Running with previous configuration instead.)"
)
String
newsha <- String -> IO String
getCurrentGitSha1 String
branchref
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
oldsha String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
newsha