summaryrefslogtreecommitdiff
path: root/src/Propellor/Gpg.hs
diff options
context:
space:
mode:
authorJoey Hess2014-11-11 12:58:53 -0400
committerJoey Hess2014-11-11 12:58:53 -0400
commit84304821bebf9b794fae56f616b50ae1d06014d2 (patch)
treee43b936fc51e9c2bb75399cd23885dcb8b4b661c /src/Propellor/Gpg.hs
parentf559ccaf738535ad4b0ebb0b520542055d8ae305 (diff)
propellor spin
Diffstat (limited to 'src/Propellor/Gpg.hs')
-rw-r--r--src/Propellor/Gpg.hs101
1 files changed, 101 insertions, 0 deletions
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