propellor spin

propellor.cabal

@@ -113,8 +113,9 @@ Library
   Other-Modules:
     Propellor.Types.Info
     Propellor.CmdLine
-    Propellor.Keyring
+    Propellor.Gpg
     Propellor.SimpleSh
+    Propellor.PrivData.Paths
     Propellor.Property.Docker.Shim
     Utility.Applicative
     Utility.Data

src/Propellor/CmdLine.hs

@@ -13,7 +13,8 @@ import System.Posix.IO
 import Data.Time.Clock.POSIX
 
 import Propellor
-import Propellor.Keyring
+import Propellor.PrivData.Paths
+import Propellor.Gpg
 import qualified Propellor.Property.Docker as Docker
 import qualified Propellor.Property.Docker.Shim as DockerShim
 import Utility.FileMode

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

src/Propellor/Keyring.hs

@@ -1,50 +0,0 @@
-module Propellor.Keyring where
-
-import Propellor
-import Utility.SafeCommand
-
-keyring :: FilePath
-keyring = privDataDir </> "keyring.gpg"
-
-addKey :: String -> IO ()
-addKey keyid = exitBool =<< allM id [ gpg, gitadd, gitconfig, gitcommit ]
-  where
-	gpg = do
-		createDirectoryIfMissing True privDataDir
-		boolSystem "sh"
-			[ Param "-c"
-			, Param $ "gpg --export " ++ keyid ++ " | gpg " ++
-				unwords (gpgopts ++ ["--import"])
-			]
-	gitadd = boolSystem "git"
-		[ Param "add"
-		, File keyring
-		]
-
-	gitconfig = boolSystem "git"
-		[ Param "config"
-		, Param "user.signingkey"
-		, Param keyid
-		]
-
-	gitcommit = gitCommit
-		[ File keyring
-		, Param "-m"
-		, Param "propellor addkey"
-		]
-
-	gpgopts =
-		[ "--options"
-		, "/dev/null"
-		, "--no-default-keyring"
-		, "--keyring", keyring
-		]
-
-{- 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

src/Propellor/PrivData.hs

@@ -3,7 +3,6 @@
 module Propellor.PrivData where
 
 import Control.Applicative
-import System.FilePath
 import System.IO
 import System.Directory
 import Data.Maybe
@@ -19,10 +18,11 @@ import Propellor.Types
 import Propellor.Types.Info
 import Propellor.Message
 import Propellor.Info
+import Propellor.Gpg
+import Propellor.PrivData.Paths
 import Utility.Monad
 import Utility.PartialPrelude
 import Utility.Exception
-import Utility.Process
 import Utility.Tmp
 import Utility.SafeCommand
 import Utility.Misc
@@ -146,30 +146,3 @@ decryptPrivData = fromMaybe M.empty . readish <$> gpgDecrypt privDataFile
 
 makePrivDataDir :: IO ()
 makePrivDataDir = createDirectoryIfMissing False privDataDir
-
-privDataDir :: FilePath
-privDataDir = "privdata"
-
-privDataFile :: FilePath
-privDataFile = privDataDir </> "privdata.gpg"
-
-privDataLocal :: FilePath
-privDataLocal = privDataDir </> "local"
-
-gpgDecrypt :: FilePath -> IO String
-gpgDecrypt f = ifM (doesFileExist f)
-	( readProcess "gpg" ["--decrypt", f]
-	, return ""
-	)
-
-gpgEncrypt :: FilePath -> String -> IO ()
-gpgEncrypt f s = do
-	encrypted <- writeReadProcessEnv "gpg"
-		[ "--default-recipient-self"
-		, "--armor"
-		, "--encrypt"
-		]
-		Nothing
-		(Just $ flip hPutStr s)
-		Nothing
-	viaTmp writeFile f encrypted

src/Propellor/PrivData/Paths.hs

@@ -0,0 +1,12 @@
+module Propellor.PrivData.Paths where
+
+import System.FilePath
+
+privDataDir :: FilePath
+privDataDir = "privdata"
+
+privDataFile :: FilePath
+privDataFile = privDataDir </> "privdata.gpg"
+
+privDataLocal :: FilePath
+privDataLocal = privDataDir </> "local"