summaryrefslogtreecommitdiff
path: root/src/Propellor/Gpg.hs
blob: e478f6103f107bc3ca1e282135316137bb2f2474 (plain)
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