summaryrefslogtreecommitdiff
path: root/src/Propellor/Gpg.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Propellor/Gpg.hs')
-rw-r--r--src/Propellor/Gpg.hs115
1 files changed, 115 insertions, 0 deletions
diff --git a/src/Propellor/Gpg.hs b/src/Propellor/Gpg.hs
new file mode 100644
index 00000000..572be190
--- /dev/null
+++ b/src/Propellor/Gpg.hs
@@ -0,0 +1,115 @@
+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 Propellor.Message
+import Utility.SafeCommand
+import Utility.Process
+import Utility.Monad
+import Utility.Misc
+import Utility.Tmp
+
+type KeyId = String
+
+keyring :: FilePath
+keyring = privDataDir </> "keyring.gpg"
+
+-- Lists the keys in propellor's keyring.
+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 (uncurry actionMessage)
+ [ ("adding key to propellor's keyring", addkeyring)
+ , ("staging propellor's keyring", gitadd keyring)
+ , ("updating encryption of any privdata", reencryptprivdata)
+ , ("configuring git signing to use key", gitconfig)
+ , ("committing changes", gitcommit)
+ ]
+ where
+ addkeyring = 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 = ifM (snd <$> processTranscript "gpg" ["--list-secret-keys", keyid] Nothing)
+ ( boolSystem "git"
+ [ Param "config"
+ , Param "user.signingkey"
+ , Param keyid
+ ]
+ , do
+ warningMessage $ "Cannot find a secret key for key " ++ keyid ++ ", so not configuring git user.signingkey to use this key."
+ return True
+ )
+
+ 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 ""
+ )
+
+-- Encrypt file to all keys in propellor's keyring.
+gpgEncrypt :: FilePath -> String -> IO ()
+gpgEncrypt f s = do
+ keyids <- listPubKeys
+ let opts =
+ [ "--default-recipient-self"
+ , "--armor"
+ , "--encrypt"
+ , "--trust-model", "always"
+ ] ++ concatMap (\k -> ["--recipient", k]) keyids
+ encrypted <- writeReadProcessEnv "gpg" opts
+ Nothing
+ (Just $ flip hPutStr s)
+ Nothing
+ viaTmp writeFile f encrypted