diff options
| -rw-r--r-- | Command/TransferKeys.hs | 4 | ||||
| -rw-r--r-- | Remote/Helper/Special.hs | 1 | ||||
| -rw-r--r-- | RemoteDaemon/Core.hs | 2 | ||||
| -rw-r--r-- | Utility/Gpg.hs | 2 | ||||
| -rw-r--r-- | Utility/Process.hs | 14 | ||||
| -rw-r--r-- | Utility/SimpleProtocol.hs | 6 |
6 files changed, 15 insertions, 14 deletions
diff --git a/Command/TransferKeys.hs b/Command/TransferKeys.hs index 990582196..b787fe9be 100644 --- a/Command/TransferKeys.hs +++ b/Command/TransferKeys.hs @@ -16,7 +16,7 @@ import Logs.Location import Annex.Transfer import qualified Remote import Types.Key -import Utility.SimpleProtocol (ioHandles) +import Utility.SimpleProtocol (dupIoHandles) import Git.Types (RemoteName) data TransferRequest = TransferRequest Direction Remote Key AssociatedFile @@ -30,7 +30,7 @@ seek = withNothing start start :: CommandStart start = do - (readh, writeh) <- liftIO ioHandles + (readh, writeh) <- liftIO dupIoHandles runRequests readh writeh runner stop where diff --git a/Remote/Helper/Special.hs b/Remote/Helper/Special.hs index 9f219e8b1..696a43a7a 100644 --- a/Remote/Helper/Special.hs +++ b/Remote/Helper/Special.hs @@ -42,6 +42,7 @@ import Remote.Helper.Chunked as X import Remote.Helper.Encryptable as X import Remote.Helper.Messages import Annex.Content +import Messages.Progress import qualified Git import qualified Git.Command import qualified Git.Construct diff --git a/RemoteDaemon/Core.hs b/RemoteDaemon/Core.hs index 405a1fd88..a861ec29b 100644 --- a/RemoteDaemon/Core.hs +++ b/RemoteDaemon/Core.hs @@ -28,7 +28,7 @@ import qualified Data.Map as M runForeground :: IO () runForeground = do - (readh, writeh) <- ioHandles + (readh, writeh) <- dupIoHandles ichan <- newTChanIO :: IO (TChan Consumed) ochan <- newTChanIO :: IO (TChan Emitted) diff --git a/Utility/Gpg.hs b/Utility/Gpg.hs index 37508a495..3112db1bd 100644 --- a/Utility/Gpg.hs +++ b/Utility/Gpg.hs @@ -87,7 +87,7 @@ readStrict params = do pipeStrict :: [CommandParam] -> String -> IO String pipeStrict params input = do params' <- stdParams params - withBothHandles createProcessSuccess (proc gpgcmd params') $ \(to, from) -> do + withIOHandles createProcessSuccess (proc gpgcmd params') $ \(to, from) -> do hSetBinaryMode to True hSetBinaryMode from True hPutStr to input diff --git a/Utility/Process.hs b/Utility/Process.hs index 8fefaa54c..ae09b5958 100644 --- a/Utility/Process.hs +++ b/Utility/Process.hs @@ -25,14 +25,14 @@ module Utility.Process ( processTranscript, processTranscript', withHandle, - withBothHandles, + withIOHandles, withQuietOutput, createProcess, startInteractiveProcess, stdinHandle, stdoutHandle, stderrHandle, - bothHandles, + ioHandles, processHandle, devNull, ) where @@ -255,12 +255,12 @@ withHandle h creator p a = creator p' $ a . select (stderrHandle, base { std_err = CreatePipe }) {- Like withHandle, but passes (stdin, stdout) handles to the action. -} -withBothHandles +withIOHandles :: CreateProcessRunner -> CreateProcess -> ((Handle, Handle) -> IO a) -> IO a -withBothHandles creator p a = creator p' $ a . bothHandles +withIOHandles creator p a = creator p' $ a . ioHandles where p' = p { std_in = CreatePipe @@ -303,9 +303,9 @@ stdoutHandle _ = error "expected stdoutHandle" stderrHandle :: HandleExtractor stderrHandle (_, _, Just h, _) = h stderrHandle _ = error "expected stderrHandle" -bothHandles :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> (Handle, Handle) -bothHandles (Just hin, Just hout, _, _) = (hin, hout) -bothHandles _ = error "expected bothHandles" +ioHandles :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> (Handle, Handle) +ioHandles (Just hin, Just hout, _, _) = (hin, hout) +ioHandles _ = error "expected ioHandles" processHandle :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> ProcessHandle processHandle (_, _, _, pid) = pid diff --git a/Utility/SimpleProtocol.hs b/Utility/SimpleProtocol.hs index 4a2d8635e..52284d457 100644 --- a/Utility/SimpleProtocol.hs +++ b/Utility/SimpleProtocol.hs @@ -16,7 +16,7 @@ module Utility.SimpleProtocol ( parse1, parse2, parse3, - ioHandles, + dupIoHandles, ) where import Data.Char @@ -80,8 +80,8 @@ splitWord = separate isSpace - will mess up the protocol. To avoid that, close stdin, and - and duplicate stderr to stdout. Return two new handles - that are duplicates of the original (stdin, stdout). -} -ioHandles :: IO (Handle, Handle) -ioHandles = do +dupIoHandles :: IO (Handle, Handle) +duoIoHandles = do readh <- hDuplicate stdin writeh <- hDuplicate stdout nullh <- openFile devNull ReadMode |