From 84304821bebf9b794fae56f616b50ae1d06014d2 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 11 Nov 2014 12:58:53 -0400 Subject: propellor spin --- src/Propellor/Gpg.hs | 101 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 101 insertions(+) create mode 100644 src/Propellor/Gpg.hs (limited to 'src/Propellor/Gpg.hs') diff --git a/src/Propellor/Gpg.hs b/src/Propellor/Gpg.hs new file mode 100644 index 00000000..c65d06ec --- /dev/null +++ b/src/Propellor/Gpg.hs @@ -0,0 +1,101 @@ +module Propellor.Gpg where + +import Control.Applicative +import System.IO +import System.FilePath +import System.Directory +import Data.Maybe +import Data.List.Utils + +import Propellor.PrivData.Paths +import Utility.SafeCommand +import Utility.Process +import Utility.Monad +import Utility.Misc +import Utility.Tmp + +type KeyId = String + +keyring :: FilePath +keyring = privDataDir "keyring.gpg" + +listPubKeys :: IO [KeyId] +listPubKeys = parse . lines <$> readProcess "gpg" listopts + where + listopts = useKeyringOpts ++ ["--with-colons", "--list-public-keys"] + parse = mapMaybe (keyIdField . split ":") + keyIdField ("pub":_:_:_:f:_) = Just f + keyIdField _ = Nothing + +useKeyringOpts :: [String] +useKeyringOpts = + [ "--options" + , "/dev/null" + , "--no-default-keyring" + , "--keyring", keyring + ] + +addKey :: KeyId -> IO () +addKey keyid = exitBool =<< allM id + [ gpg, gitadd keyring, reencryptprivdata, gitconfig, gitcommit ] + where + gpg = do + createDirectoryIfMissing True privDataDir + boolSystem "sh" + [ Param "-c" + , Param $ "gpg --export " ++ keyid ++ " | gpg " ++ + unwords (useKeyringOpts ++ ["--import"]) + ] + + reencryptprivdata = ifM (doesFileExist privDataFile) + ( do + gpgEncrypt privDataFile =<< gpgDecrypt privDataFile + gitadd privDataFile + , return True + ) + + gitadd f = boolSystem "git" + [ Param "add" + , File f + ] + + gitconfig = boolSystem "git" + [ Param "config" + , Param "user.signingkey" + , Param keyid + ] + + gitcommit = gitCommit + [ File keyring + , Param "-m" + , Param "propellor addkey" + ] + +{- Automatically sign the commit if there'a a keyring. -} +gitCommit :: [CommandParam] -> IO Bool +gitCommit ps = do + k <- doesFileExist keyring + boolSystem "git" $ catMaybes $ + [ Just (Param "commit") + , if k then Just (Param "--gpg-sign") else Nothing + ] ++ map Just ps + +gpgDecrypt :: FilePath -> IO String +gpgDecrypt f = ifM (doesFileExist f) + ( readProcess "gpg" ["--decrypt", f] + , return "" + ) + +gpgEncrypt :: FilePath -> String -> IO () +gpgEncrypt f s = do + keyids <- listPubKeys + let opts = + [ "--default-recipient-self" + , "--armor" + , "--encrypt" + ] ++ concatMap (\k -> ["--recipient", k]) keyids + encrypted <- writeReadProcessEnv "gpg" opts + Nothing + (Just $ flip hPutStr s) + Nothing + viaTmp writeFile f encrypted -- cgit v1.2.3