summaryrefslogtreecommitdiff
path: root/Crypto.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-12-20 21:47:56 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-12-20 23:24:06 -0400
commitc11cfea35555ae3bab429c283d8c7571d285d4b1 (patch)
tree43609565bb31a9833916be75afa11545ac3a6b2b /Crypto.hs
parentbb84f6e4bd57b15b9e83e2baf1b678d66d5009be (diff)
split out Utility.Gpg with the generic gpg interface, from Crypto
Diffstat (limited to 'Crypto.hs')
-rw-r--r--Crypto.hs84
1 files changed, 7 insertions, 77 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