1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
|
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"
, "--trust-model", "always"
] ++ concatMap (\k -> ["--recipient", k]) keyids
encrypted <- writeReadProcessEnv "gpg" opts
Nothing
(Just $ flip hPutStr s)
Nothing
viaTmp writeFile f encrypted
|
