2014-11-11 16:58:53 +00:00
|
|
|
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"
|
2014-11-11 17:26:31 +00:00
|
|
|
, "--trust-model", "always"
|
2014-11-11 16:58:53 +00:00
|
|
|
] ++ concatMap (\k -> ["--recipient", k]) keyids
|
|
|
|
encrypted <- writeReadProcessEnv "gpg" opts
|
|
|
|
Nothing
|
|
|
|
(Just $ flip hPutStr s)
|
|
|
|
Nothing
|
|
|
|
viaTmp writeFile f encrypted
|