diff --git a/Creds.hs b/Creds.hs index 2852906ecb..d4b4d9eafa 100644 --- a/Creds.hs +++ b/Creds.hs @@ -35,6 +35,7 @@ import Remote.Helper.Encryptable (remoteCipher, remoteCipher', embedCreds, Encry import Utility.Env (getEnv) import qualified Data.ByteString.Lazy.Char8 as L +import qualified Data.ByteString.Char8 as S import qualified Data.Map as M import Utility.Base64 @@ -86,7 +87,7 @@ setRemoteCredPair' mkval parseconfig encsetup c gc storage mcreds = case mcreds cmd <- gpgCmd <$> Annex.getGitConfig s <- liftIO $ encrypt cmd (pc, gc) cipher (feedBytes $ L.pack $ encodeCredPair creds) - (readBytes $ return . L.unpack) + (readBytesStrictly $ return . S.unpack) return $ M.insert key (mkval (Accepted (toB64 s))) c storeconfig creds key Nothing = return $ M.insert key (mkval (Accepted (toB64 $ encodeCredPair creds))) c @@ -114,7 +115,7 @@ getRemoteCredPair c gc storage = maybe fromcache (return . Just) =<< fromenv cmd <- gpgCmd <$> Annex.getGitConfig mcreds <- liftIO $ catchMaybeIO $ decrypt cmd (c, gc) cipher (feedBytes $ L.pack $ fromB64 enccreds) - (readBytes $ return . L.unpack) + (readBytesStrictly $ return . S.unpack) case mcreds of Just creds -> fromcreds creds Nothing -> do diff --git a/Crypto.hs b/Crypto.hs index 88b85aa7bc..ca10576eb8 100644 --- a/Crypto.hs +++ b/Crypto.hs @@ -28,6 +28,7 @@ module Crypto ( feedFile, feedBytes, readBytes, + readBytesStrictly, encrypt, decrypt, LensGpgEncParams(..), @@ -187,25 +188,35 @@ feedBytes = flip L.hPut readBytes :: (MonadIO m) => (L.ByteString -> m a) -> Reader m a readBytes a h = liftIO (L.hGetContents h) >>= a +readBytesStrictly :: (MonadIO m) => (S.ByteString -> m a) -> Reader m a +readBytesStrictly a h = liftIO (S.hGetContents h) >>= a + + {- Runs a Feeder action, that generates content that is symmetrically - encrypted with the Cipher (unless it is empty, in which case - public-key encryption is used) using the given gpg options, and then - - read by the Reader action. -} + - read by the Reader action. + - + - Note that the Reader must fully consume gpg's input before returning. + -} encrypt :: (MonadIO m, MonadMask m, LensGpgEncParams c) => Gpg.GpgCmd -> c -> Cipher -> Feeder -> Reader m a -> m a encrypt cmd c cipher = case cipher of Cipher{} -> Gpg.feedRead cmd (params ++ Gpg.stdEncryptionParams True) $ cipherPassphrase cipher - MacOnlyCipher{} -> Gpg.pipeLazy cmd $ params ++ Gpg.stdEncryptionParams False + MacOnlyCipher{} -> Gpg.feedRead' cmd $ params ++ Gpg.stdEncryptionParams False where params = getGpgEncParams c {- Runs a Feeder action, that generates content that is decrypted with the - Cipher (or using a private key if the Cipher is empty), and read by the - - Reader action. -} + - Reader action. + - + - Note that the Reader must fully consume gpg's input before returning. + - -} decrypt :: (MonadIO m, MonadMask m, LensGpgEncParams c) => Gpg.GpgCmd -> c -> Cipher -> Feeder -> Reader m a -> m a decrypt cmd c cipher = case cipher of Cipher{} -> Gpg.feedRead cmd params $ cipherPassphrase cipher - MacOnlyCipher{} -> Gpg.pipeLazy cmd params + MacOnlyCipher{} -> Gpg.feedRead' cmd params where params = Param "--decrypt" : getGpgDecParams c diff --git a/Utility/Gpg.hs b/Utility/Gpg.hs index 321f5ec239..c9943303d2 100644 --- a/Utility/Gpg.hs +++ b/Utility/Gpg.hs @@ -17,7 +17,7 @@ module Utility.Gpg ( stdEncryptionParams, pipeStrict, feedRead, - pipeLazy, + feedRead', findPubKeys, UserId, secretKeys, @@ -149,8 +149,7 @@ pipeStrict (GpgCmd cmd) params input = do - Runs gpg in batch mode; this is necessary to avoid gpg 2.x prompting for - the passphrase. - - - Note that to avoid deadlock with the cleanup stage, - - the reader must fully consume gpg's input before returning. -} + - Note that the reader must fully consume gpg's input before returning. -} feedRead :: (MonadIO m, MonadMask m) => GpgCmd -> [CommandParam] -> String -> (Handle -> IO ()) -> (Handle -> m a) -> m a feedRead cmd params passphrase feeder reader = do #ifndef mingw32_HOST_OS @@ -179,11 +178,11 @@ feedRead cmd params passphrase feeder reader = do go $ passphrasefile ++ params #endif where - go params' = pipeLazy cmd params' feeder reader + go params' = feedRead' cmd params' feeder reader {- Like feedRead, but without passphrase. -} -pipeLazy :: (MonadIO m, MonadMask m) => GpgCmd -> [CommandParam] -> (Handle -> IO ()) -> (Handle -> m a) -> m a -pipeLazy (GpgCmd cmd) params feeder reader = do +feedRead' :: (MonadIO m, MonadMask m) => GpgCmd -> [CommandParam] -> (Handle -> IO ()) -> (Handle -> m a) -> m a +feedRead' (GpgCmd cmd) params feeder reader = do params' <- liftIO $ stdParams $ Param "--batch" : params let p = (proc cmd params') { std_in = CreatePipe