make gpg code more generic

This commit is contained in:
Joey Hess 2011-12-20 21:30:00 -04:00
parent 8e2f74f7ab
commit bb84f6e4bd

View file

@ -71,7 +71,7 @@ genCipher c = do
random <- genrandom random <- genrandom
encryptCipher (Cipher random) ks encryptCipher (Cipher random) ks
where where
genrandom = gpgRead genrandom = gpgReadStrict
-- Armor the random data, to avoid newlines, -- Armor the random data, to avoid newlines,
-- since gpg only reads ciphers up to the first -- since gpg only reads ciphers up to the first
-- newline. -- newline.
@ -150,12 +150,12 @@ encryptKey c k = Key
{- Runs an action, passing it a handle from which it can {- Runs an action, passing it a handle from which it can
- stream encrypted content. -} - stream encrypted content. -}
withEncryptedHandle :: Cipher -> IO L.ByteString -> (Handle -> IO a) -> IO a withEncryptedHandle :: Cipher -> IO L.ByteString -> (Handle -> IO a) -> IO a
withEncryptedHandle = gpgCipherHandle [Params "--symmetric --force-mdc"] withEncryptedHandle = gpgPassphraseHandle [Params "--symmetric --force-mdc"] . cipherPassphrase
{- Runs an action, passing it a handle from which it can {- Runs an action, passing it a handle from which it can
- stream decrypted content. -} - stream decrypted content. -}
withDecryptedHandle :: Cipher -> IO L.ByteString -> (Handle -> IO a) -> IO a withDecryptedHandle :: Cipher -> IO L.ByteString -> (Handle -> IO a) -> IO a
withDecryptedHandle = gpgCipherHandle [Param "--decrypt"] withDecryptedHandle = gpgPassphraseHandle [Param "--decrypt"] . cipherPassphrase
{- Streams encrypted content to an action. -} {- Streams encrypted content to an action. -}
withEncryptedContent :: Cipher -> IO L.ByteString -> (L.ByteString -> IO a) -> IO a withEncryptedContent :: Cipher -> IO L.ByteString -> (L.ByteString -> IO a) -> IO a
@ -180,11 +180,14 @@ gpgParams params = do
-- be quiet, even about checking the trustdb -- be quiet, even about checking the trustdb
defaults = ["--quiet", "--trust-model", "always"] defaults = ["--quiet", "--trust-model", "always"]
gpgRead :: [CommandParam] -> IO String {- Runs gpg with some params and returns its stdout, strictly. -}
gpgRead params = do gpgReadStrict :: [CommandParam] -> IO String
gpgReadStrict params = do
params' <- gpgParams params params' <- gpgParams params
pOpen ReadFromPipe "gpg" params' hGetContentsStrict pOpen ReadFromPipe "gpg" params' hGetContentsStrict
{- Runs gpg, piping an input value to it, and returninging its stdout,
- strictly. -}
gpgPipeStrict :: [CommandParam] -> String -> IO String gpgPipeStrict :: [CommandParam] -> String -> IO String
gpgPipeStrict params input = do gpgPipeStrict params input = do
params' <- gpgParams params params' <- gpgParams params
@ -194,23 +197,24 @@ gpgPipeStrict params input = do
forceSuccess pid forceSuccess pid
return output return output
{- Runs gpg with a cipher and some parameters, feeding it an input, {- Runs gpg with some parameters, first feeding it a passphrase via
- and passing a handle to its output to an action. - --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, - Note that to avoid deadlock with the cleanup stage,
- the action must fully consume gpg's input before returning. -} - the action must fully consume gpg's input before returning. -}
gpgCipherHandle :: [CommandParam] -> Cipher -> IO L.ByteString -> (Handle -> IO a) -> IO a gpgPassphraseHandle :: [CommandParam] -> String -> IO L.ByteString -> (Handle -> IO a) -> IO a
gpgCipherHandle params c a b = do gpgPassphraseHandle params passphrase a b = do
-- pipe the passphrase into gpg on a fd -- pipe the passphrase into gpg on a fd
(frompipe, topipe) <- createPipe (frompipe, topipe) <- createPipe
_ <- forkIO $ do _ <- forkIO $ do
toh <- fdToHandle topipe toh <- fdToHandle topipe
hPutStrLn toh $ cipherPassphrase c hPutStrLn toh passphrase
hClose toh hClose toh
let Fd passphrasefd = frompipe let Fd pfd = frompipe
let passphrase = [Param "--passphrase-fd", Param $ show passphrasefd] let passphrasefd = [Param "--passphrase-fd", Param $ show pfd]
params' <- gpgParams $ passphrase ++ params params' <- gpgParams $ passphrasefd ++ params
(pid, fromh, toh) <- hPipeBoth "gpg" params' (pid, fromh, toh) <- hPipeBoth "gpg" params'
pid2 <- forkProcess $ do pid2 <- forkProcess $ do
L.hPut toh =<< a L.hPut toh =<< a
@ -226,7 +230,7 @@ gpgCipherHandle params c a b = do
return ret return ret
configKeyIds :: RemoteConfig -> IO KeyIds configKeyIds :: RemoteConfig -> IO KeyIds
configKeyIds c = parse <$> gpgRead params configKeyIds c = parse <$> gpgReadStrict params
where where
params = [Params "--with-colons --list-public-keys", params = [Params "--with-colons --list-public-keys",
Param $ configGet c "encryption"] Param $ configGet c "encryption"]