From d996637fd68430b4236d2899c49827cbf457471f Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 17 Apr 2011 00:34:38 -0400 Subject: fix stall while storing encrypted data in bup Forking a new process rather than relying on a thread to feed gpg. The feeder thread was stalling, probably when the main thread got to the point it was wait()ing on the gpg to exit. --- Crypto.hs | 42 ++++++++++++++++++++++++++++-------------- Remote/Bup.hs | 31 +++++++++++++------------------ 2 files changed, 41 insertions(+), 32 deletions(-) diff --git a/Crypto.hs b/Crypto.hs index 25d9a1157..4ec186ea2 100644 --- a/Crypto.hs +++ b/Crypto.hs @@ -17,6 +17,7 @@ module Crypto ( extractCipher, decryptCipher, encryptKey, + withEncryptedContentHandle, withEncryptedContent, withDecryptedContent, ) where @@ -33,8 +34,10 @@ import Data.Bits.Utils import System.IO import System.Posix.IO import System.Posix.Types +import System.Posix.Process import Control.Concurrent import Control.Exception +import System.Exit import Types import Key @@ -116,6 +119,11 @@ encryptKey (Cipher c) k = keyMtime = Nothing -- to avoid leaking data } +{- Runs an action passing it a handle from which it can + - stream encrypted content. -} +withEncryptedContentHandle :: Cipher -> L.ByteString -> (Handle -> IO a) -> IO a +withEncryptedContentHandle = gpgCipherHandle [Params "--symmetric --force-mdc"] + {- Streams encrypted content to an action. -} withEncryptedContent :: Cipher -> L.ByteString -> (L.ByteString -> IO a) -> IO a withEncryptedContent = gpgCipher [Params "--symmetric --force-mdc"] @@ -142,17 +150,10 @@ gpgPipeStrict params input = do forceSuccess pid return output -gpgPipeBytes :: [CommandParam] -> L.ByteString -> IO (PipeHandle, L.ByteString) -gpgPipeBytes params input = do - (pid, fromh, toh) <- hPipeBoth "gpg" (gpgParams params) - _ <- forkIO $ finally (L.hPut toh input) (hClose toh) - output <- L.hGetContents fromh - return (pid, output) - {- Runs gpg with a cipher and some parameters, feeding it an input, - - and piping its output lazily to an action. -} -gpgCipher :: [CommandParam] -> Cipher -> L.ByteString -> (L.ByteString -> IO a) -> IO a -gpgCipher params (Cipher c) input a = do + - and passing a handle to its output to an action. -} +gpgCipherHandle :: [CommandParam] -> Cipher -> L.ByteString -> (Handle -> IO a) -> IO a +gpgCipherHandle params (Cipher c) input a = do -- pipe the passphrase into gpg on a fd (frompipe, topipe) <- createPipe _ <- forkIO $ do @@ -161,16 +162,29 @@ gpgCipher params (Cipher c) input a = do hClose toh let Fd passphrasefd = frompipe let passphrase = [Param "--passphrase-fd", Param $ show passphrasefd] - (pid, output) <- gpgPipeBytes (passphrase ++ params) input - - ret <- a output + + (pid, fromh, toh) <- hPipeBoth "gpg" $ + gpgParams $ passphrase ++ params + _ <- forkProcess $ do + L.hPut toh input + hClose toh + exitSuccess + hClose toh + ret <- a fromh -- cleanup forceSuccess pid closeFd frompipe - return ret +{- Runs gpg with a cipher and some parameters, feeding it an input, + - and piping its output lazily to an action. -} +gpgCipher :: [CommandParam] -> Cipher -> L.ByteString -> (L.ByteString -> IO a) -> IO a +gpgCipher params c input a = do + gpgCipherHandle params c input $ \h -> do + content <- L.hGetContents h + a content + configKeyIds :: RemoteConfig -> IO KeyIds configKeyIds c = do let k = configGet c "encryption" diff --git a/Remote/Bup.hs b/Remote/Bup.hs index 6f4c9278e..771212372 100644 --- a/Remote/Bup.hs +++ b/Remote/Bup.hs @@ -17,7 +17,6 @@ import System.Process import System.Exit import System.FilePath import Data.List.Utils -import System.Cmd.Utils import RemoteClass import Types @@ -96,6 +95,15 @@ bup command buprepo params = do showProgress -- make way for bup output liftIO $ boolSystem "bup" $ bupParams command buprepo params +pipeBup :: [CommandParam] -> Maybe Handle -> Maybe Handle -> IO Bool +pipeBup params inh outh = do + p <- runProcess "bup" (toCommand params) + Nothing Nothing inh outh Nothing + ok <- waitForProcess p + case ok of + ExitSuccess -> return True + _ -> return False + bupSplitParams :: Git.Repo -> BupRepo -> Key -> CommandParam -> Annex [CommandParam] bupSplitParams r buprepo k src = do o <- getConfig r "bup-split-options" "" @@ -118,28 +126,15 @@ storeEncrypted r buprepo (cipher, enck) k = do params <- bupSplitParams r buprepo enck (Param "-") liftIO $ flip catch (const $ return False) $ do content <- L.readFile src - -- FIXME hangs after a while - (pid, h) <- hPipeTo "bup" (toCommand params) - withEncryptedContent cipher content $ L.hPut h - hClose h - forceSuccess pid - return True + withEncryptedContentHandle cipher content $ \h -> do + pipeBup params (Just h) Nothing retrieve :: BupRepo -> Key -> FilePath -> Annex Bool retrieve buprepo k f = do let params = bupParams "join" buprepo [Param $ show k] - ret <- liftIO $ try $ do - -- pipe bup's stdout directly to file + liftIO $ flip catch (const $ return False) $ do tofile <- openFile f WriteMode - p <- runProcess "bup" (toCommand params) - Nothing Nothing Nothing (Just tofile) Nothing - r <- waitForProcess p - case r of - ExitSuccess -> return True - _ -> return False - case ret of - Right r -> return r - Left _ -> return False + pipeBup params Nothing (Just tofile) retrieveEncrypted :: BupRepo -> (Cipher, Key) -> FilePath -> Annex Bool retrieveEncrypted bupreoo (cipher, enck) f = do -- cgit v1.2.3