7245a9ed53
Make sure to relay any remaining stderr from the process after it has
shut down, rather than closing stderr just before shutdown. This avoids
a situation where the process is still running and tries to write to
stderr, getting a SIGPIPE. And, it ensures that no stderr output is
lost.
This may fix a problem encountered by datalad on windows, where it hangs
during the external special remote shutdown.
Before commit a49d300545, it closed stdin
and stdout, but left stderr open, and never killed the stderr waiter
thread, which presumably exited on its own. For async exception
safety, do need to at make sure that thread gets waited on, as that
commit does, but it introduced this problem.
Note that, the process's stdout is closed before waiting on it. It's too
late for anything it writes to stdout to be processed, and since we're
not going to consume any such writes, this avoids the process getting
blocked writing to stdout due to us not reading what it's buffered. This
does mean that if the process writes to stdout too late, it will get a
SIGPIPE. (This was already the case before the above-mentioned commit.)
In practice, I think only the protocol's ERROR is allowed to be
sent at a point where this could happen.
99 lines
2.9 KiB
Haskell
99 lines
2.9 KiB
Haskell
{- External addon processes for special remotes and backends.
|
|
-
|
|
- Copyright 2013-2020 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
module Annex.ExternalAddonProcess where
|
|
|
|
import qualified Annex
|
|
import Annex.Common
|
|
import Git.Env
|
|
import Utility.Shell
|
|
import Messages.Progress
|
|
|
|
import Control.Concurrent.Async
|
|
import System.Log.Logger (debugM)
|
|
|
|
data ExternalAddonProcess = ExternalAddonProcess
|
|
{ externalSend :: Handle
|
|
, externalReceive :: Handle
|
|
-- Shut down the process. With True, it's forced to stop
|
|
-- immediately.
|
|
, externalShutdown :: Bool -> IO ()
|
|
, externalPid :: ExternalAddonPID
|
|
, externalProgram :: String
|
|
}
|
|
|
|
type ExternalAddonPID = Int
|
|
|
|
data ExternalAddonStartError
|
|
= ProgramNotInstalled String
|
|
| ProgramFailure String
|
|
|
|
startExternalAddonProcess :: String -> ExternalAddonPID -> Annex (Either ExternalAddonStartError ExternalAddonProcess)
|
|
startExternalAddonProcess basecmd pid = do
|
|
errrelayer <- mkStderrRelayer
|
|
g <- Annex.gitRepo
|
|
cmdpath <- liftIO $ searchPath basecmd
|
|
liftIO $ start errrelayer g cmdpath
|
|
where
|
|
start errrelayer g cmdpath = do
|
|
(cmd, ps) <- maybe (pure (basecmd, [])) findShellCommand cmdpath
|
|
let basep = (proc cmd (toCommand ps))
|
|
{ std_in = CreatePipe
|
|
, std_out = CreatePipe
|
|
, std_err = CreatePipe
|
|
}
|
|
p <- propgit g basep
|
|
tryNonAsync (createProcess p) >>= \case
|
|
Right v -> (Right <$> started cmd errrelayer v)
|
|
`catchNonAsync` const (runerr cmdpath)
|
|
Left _ -> runerr cmdpath
|
|
|
|
started cmd errrelayer pall@(Just hin, Just hout, Just herr, ph) = do
|
|
stderrelay <- async $ errrelayer herr
|
|
let shutdown forcestop = do
|
|
-- Close the process's stdin, to let it know there
|
|
-- are no more requests, so it will exit.
|
|
hClose hout
|
|
-- Close the procces's stdout as we're not going to
|
|
-- process any more output from it.
|
|
hClose hin
|
|
if forcestop
|
|
then cleanupProcess pall
|
|
else void (waitForProcess ph)
|
|
`onException` cleanupProcess pall
|
|
-- This thread will exit after consuming any
|
|
-- remaining stderr from the process.
|
|
wait stderrelay
|
|
hClose herr
|
|
return $ ExternalAddonProcess
|
|
{ externalSend = hin
|
|
, externalReceive = hout
|
|
, externalPid = pid
|
|
, externalShutdown = shutdown
|
|
, externalProgram = cmd
|
|
}
|
|
started _ _ _ = giveup "internal"
|
|
|
|
propgit g p = do
|
|
environ <- propGitEnv g
|
|
return $ p { env = Just environ }
|
|
|
|
runerr (Just cmd) =
|
|
return $ Left $ ProgramFailure $
|
|
"Cannot run " ++ cmd ++ " -- Make sure it's executable and that its dependencies are installed."
|
|
runerr Nothing = do
|
|
path <- intercalate ":" <$> getSearchPath
|
|
return $ Left $ ProgramNotInstalled $
|
|
"Cannot run " ++ basecmd ++ " -- It is not installed in PATH (" ++ path ++ ")"
|
|
|
|
protocolDebug :: ExternalAddonProcess -> Bool -> String -> IO ()
|
|
protocolDebug external sendto line = debugM "external" $ unwords
|
|
[ externalProgram external ++
|
|
"[" ++ show (externalPid external) ++ "]"
|
|
, if sendto then "<--" else "-->"
|
|
, line
|
|
]
|