split out Utility.Gpg with the generic gpg interface, from Crypto

3 files changed, 105 insertions, 81 deletions

diff --git a/Crypto.hs b/Crypto.hs
index 70ee6183b..cb1ca40d1 100644
--- a/Crypto.hs
+++ b/Crypto.hs
@@ -30,14 +30,10 @@ import qualified Data.ByteString.Lazy.Char8 as L
 import qualified Data.Map as M
 import Data.ByteString.Lazy.UTF8 (fromString)
 import Data.Digest.Pure.SHA
-import System.Posix.Types
 import Control.Applicative
-import Control.Concurrent
-import Control.Exception (finally)
-import System.Exit
-import System.Environment
 
 import Common.Annex
+import qualified Utility.Gpg as Gpg
 import Types.Key
 import Types.Remote
 import Utility.Base64
@@ -71,7 +67,7 @@ genCipher c = do
 	random <- genrandom
 	encryptCipher (Cipher random) ks
 	where
-		genrandom = gpgReadStrict
+		genrandom = Gpg.readStrict
 			-- Armor the random data, to avoid newlines,
 			-- since gpg only reads ciphers up to the first
 			-- newline.
@@ -119,7 +115,7 @@ extractCipher c =
 encryptCipher :: Cipher -> KeyIds -> IO EncryptedCipher
 encryptCipher (Cipher c) (KeyIds ks) = do
 	let ks' = nub $ sort ks -- gpg complains about duplicate recipient keyids
-	encipher <- gpgPipeStrict (encrypt++recipients ks') c
+	encipher <- Gpg.pipeStrict (encrypt++recipients ks') c
 	return $ EncryptedCipher encipher (KeyIds ks')
 	where
 		encrypt = [ Params "--encrypt" ]
@@ -132,7 +128,7 @@ encryptCipher (Cipher c) (KeyIds ks) = do
 {- Decrypting an EncryptedCipher is expensive; the Cipher should be cached. -}
 decryptCipher :: RemoteConfig -> EncryptedCipher -> IO Cipher
 decryptCipher _ (EncryptedCipher encipher _) = 
-	Cipher <$> gpgPipeStrict decrypt encipher
+	Cipher <$> Gpg.pipeStrict decrypt encipher
 	where
 		decrypt = [ Param "--decrypt" ]
 
@@ -150,12 +146,12 @@ encryptKey c k = Key
 {- Runs an action, passing it a handle from which it can 
  - stream encrypted content. -}
 withEncryptedHandle :: Cipher -> IO L.ByteString -> (Handle -> IO a) -> IO a
-withEncryptedHandle = gpgPassphraseHandle [Params "--symmetric --force-mdc"] . cipherPassphrase
+withEncryptedHandle = Gpg.passphraseHandle [Params "--symmetric --force-mdc"] . cipherPassphrase
 
 {- Runs an action, passing it a handle from which it can
  - stream decrypted content. -}
 withDecryptedHandle :: Cipher -> IO L.ByteString -> (Handle -> IO a) -> IO a
-withDecryptedHandle = gpgPassphraseHandle [Param "--decrypt"] . cipherPassphrase
+withDecryptedHandle = Gpg.passphraseHandle [Param "--decrypt"] . cipherPassphrase
 
 {- Streams encrypted content to an action. -}
 withEncryptedContent :: Cipher -> IO L.ByteString -> (L.ByteString -> IO a) -> IO a
@@ -169,74 +165,8 @@ pass :: (Cipher -> IO L.ByteString -> (Handle -> IO a) -> IO a)
       -> Cipher -> IO L.ByteString -> (L.ByteString -> IO a) -> IO a
 pass to c i a = to c i $ \h -> a =<< L.hGetContents h
 
-gpgParams :: [CommandParam] -> IO [String]
-gpgParams params = do
-	-- Enable batch mode if GPG_AGENT_INFO is set, to avoid extraneous
-	-- gpg output about password prompts.
-	e <- catchDefaultIO (getEnv "GPG_AGENT_INFO") ""
-	let batch = if null e then [] else ["--batch"]
-	return $ batch ++ defaults ++ toCommand params
-	where
-		-- be quiet, even about checking the trustdb
-		defaults = ["--quiet", "--trust-model", "always"]
-
-{- Runs gpg with some params and returns its stdout, strictly. -}
-gpgReadStrict :: [CommandParam] -> IO String
-gpgReadStrict params = do
-	params' <- gpgParams params
-	pOpen ReadFromPipe "gpg" params' hGetContentsStrict
-
-{- Runs gpg, piping an input value to it, and returninging its stdout,
- - strictly. -}
-gpgPipeStrict :: [CommandParam] -> String -> IO String
-gpgPipeStrict params input = do
-	params' <- gpgParams params
-	(pid, fromh, toh) <- hPipeBoth "gpg" params'
-	_ <- forkIO $ finally (hPutStr toh input) (hClose toh)
-	output <- hGetContentsStrict fromh
-	forceSuccess pid
-	return output
-
-{- Runs gpg with some parameters, first feeding it a passphrase via
- - --passphrase-fd, then feeding it an input, and passing a handle
- - to its output to an action.
- -
- - Note that to avoid deadlock with the cleanup stage,
- - the action must fully consume gpg's input before returning. -}
-gpgPassphraseHandle :: [CommandParam] -> String -> IO L.ByteString -> (Handle -> IO a) -> IO a
-gpgPassphraseHandle params passphrase a b = do
-	-- pipe the passphrase into gpg on a fd
-	(frompipe, topipe) <- createPipe
-	_ <- forkIO $ do
-		toh <- fdToHandle topipe
-		hPutStrLn toh passphrase
-		hClose toh
-	let Fd pfd = frompipe
-	let passphrasefd = [Param "--passphrase-fd", Param $ show pfd]
-
-	params' <- gpgParams $ passphrasefd ++ params
-	(pid, fromh, toh) <- hPipeBoth "gpg" params'
-	pid2 <- forkProcess $ do
-		L.hPut toh =<< a
-		hClose toh
-		exitSuccess
-	hClose toh
-	ret <- b fromh
-
-	-- cleanup
-	forceSuccess pid
-	_ <- getProcessStatus True False pid2
-	closeFd frompipe
-	return ret
-
 configKeyIds :: RemoteConfig -> IO KeyIds
-configKeyIds c = parse <$> gpgReadStrict params
-	where
-		params = [Params "--with-colons --list-public-keys",
-			Param $ configGet c "encryption"]
-		parse = KeyIds . map keyIdField . filter pubKey . lines
-		pubKey = isPrefixOf "pub:"
-		keyIdField s = split ":" s !! 4
+configKeyIds c = Gpg.findPubKeys $ configGet c "encryption"
 
 configGet :: RemoteConfig -> String -> String
 configGet c key = fromMaybe missing $ M.lookup key c
diff --git a/Types/Crypto.hs b/Types/Crypto.hs
index 29a4cd099..686bf5c1a 100644
--- a/Types/Crypto.hs
+++ b/Types/Crypto.hs
@@ -5,13 +5,16 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-module Types.Crypto where
+module Types.Crypto (
+	Cipher(..),
+	EncryptedCipher(..),
+	KeyIds(..),
+) where
+
+import Utility.Gpg (KeyIds(..))
 
 -- XXX ideally, this would be a locked memory region
 newtype Cipher = Cipher String
 
 data EncryptedCipher = EncryptedCipher String KeyIds
 	deriving (Ord, Eq)
-
-newtype KeyIds = KeyIds [String]
-	deriving (Ord, Eq)
diff --git a/Utility/Gpg.hs b/Utility/Gpg.hs
new file mode 100644
index 000000000..c74c2bfd0
--- /dev/null
+++ b/Utility/Gpg.hs
@@ -0,0 +1,91 @@
+{- gpg interface
+ -
+ - Copyright 2011 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Utility.Gpg where
+
+import qualified Data.ByteString.Lazy.Char8 as L
+import System.Posix.Types
+import Control.Applicative
+import Control.Concurrent
+import Control.Exception (finally)
+import System.Exit
+import System.Environment
+
+import Common
+
+newtype KeyIds = KeyIds [String]
+        deriving (Ord, Eq)
+
+stdParams :: [CommandParam] -> IO [String]
+stdParams params = do
+	-- Enable batch mode if GPG_AGENT_INFO is set, to avoid extraneous
+	-- gpg output about password prompts.
+	e <- catchDefaultIO (getEnv "GPG_AGENT_INFO") ""
+	let batch = if null e then [] else ["--batch"]
+	return $ batch ++ defaults ++ toCommand params
+	where
+		-- be quiet, even about checking the trustdb
+		defaults = ["--quiet", "--trust-model", "always"]
+
+{- Runs gpg with some params and returns its stdout, strictly. -}
+readStrict :: [CommandParam] -> IO String
+readStrict params = do
+	params' <- stdParams params
+	pOpen ReadFromPipe "gpg" params' hGetContentsStrict
+
+{- Runs gpg, piping an input value to it, and returninging its stdout,
+ - strictly. -}
+pipeStrict :: [CommandParam] -> String -> IO String
+pipeStrict params input = do
+	params' <- stdParams params
+	(pid, fromh, toh) <- hPipeBoth "gpg" params'
+	_ <- forkIO $ finally (hPutStr toh input) (hClose toh)
+	output <- hGetContentsStrict fromh
+	forceSuccess pid
+	return output
+
+{- Runs gpg with some parameters, first feeding it a passphrase via
+ - --passphrase-fd, then feeding it an input, and passing a handle
+ - to its output to an action.
+ -
+ - Note that to avoid deadlock with the cleanup stage,
+ - the action must fully consume gpg's input before returning. -}
+passphraseHandle :: [CommandParam] -> String -> IO L.ByteString -> (Handle -> IO a) -> IO a
+passphraseHandle params passphrase a b = do
+	-- pipe the passphrase into gpg on a fd
+	(frompipe, topipe) <- createPipe
+	_ <- forkIO $ do
+		toh <- fdToHandle topipe
+		hPutStrLn toh passphrase
+		hClose toh
+	let Fd pfd = frompipe
+	let passphrasefd = [Param "--passphrase-fd", Param $ show pfd]
+
+	params' <- stdParams $ passphrasefd ++ params
+	(pid, fromh, toh) <- hPipeBoth "gpg" params'
+	pid2 <- forkProcess $ do
+		L.hPut toh =<< a
+		hClose toh
+		exitSuccess
+	hClose toh
+	ret <- b fromh
+
+	-- cleanup
+	forceSuccess pid
+	_ <- getProcessStatus True False pid2
+	closeFd frompipe
+	return ret
+
+{- Finds gpg public keys matching some string. (Could be an email address,
+ - a key id, or a name. -}
+findPubKeys :: String -> IO KeyIds
+findPubKeys for = KeyIds . parse <$> readStrict params
+	where
+		params = [Params "--with-colons --list-public-keys", Param for]
+		parse = map keyIdField . filter pubKey . lines
+		pubKey = isPrefixOf "pub:"
+		keyIdField s = split ":" s !! 4