summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-10-01 23:01:29 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-10-01 23:01:29 -0400
commit3dfe4819b992b5486f5bca5fda9f64c7b3ed24a6 (patch)
tree498640c261666014080b9f129aab6286d6527171
parent7701976d6d40697ef40701c0b4c38321e6ca2ceb (diff)
bring back default SIGINT handler
This seems to fix a problem I've recently seen where ctrl-c during rsync leads to `git annex get` moving on to the next thing rather than exiting. Seems likely that started happening with the switch to System.Process (d1da9cf221aeea5c7ac8a313a18b559791a04f12), as the old code took care to install a default SIGINT handler. Note that since the bug was only occurring sometimes, I am not 100% sure I've squashed it, although I seem to have.
-rw-r--r--CmdLine.hs5
-rw-r--r--Utility/Rsync.hs2
-rw-r--r--Utility/SafeCommand.hs2
-rw-r--r--doc/bugs/signal_weirdness.mdwn2
4 files changed, 6 insertions, 5 deletions
diff --git a/CmdLine.hs b/CmdLine.hs
index b3aeb57aa..a960886fe 100644
--- a/CmdLine.hs
+++ b/CmdLine.hs
@@ -15,6 +15,7 @@ import qualified Control.Exception as E
import qualified Data.Map as M
import Control.Exception (throw)
import System.Console.GetOpt
+import System.Posix.Signals
import Common.Annex
import qualified Annex
@@ -108,7 +109,9 @@ tryRun' errnum state cmd (a:as) = do
{- Actions to perform each time ran. -}
startup :: Annex Bool
-startup = return True
+startup = liftIO $ do
+ void $ installHandler sigINT Default Nothing
+ return True
{- Cleanup actions. -}
shutdown :: Bool -> Annex Bool
diff --git a/Utility/Rsync.hs b/Utility/Rsync.hs
index 08caeb12b..f8e19eb57 100644
--- a/Utility/Rsync.hs
+++ b/Utility/Rsync.hs
@@ -53,7 +53,7 @@ rsync = boolSystem "rsync"
- The params must enable rsync's --progress mode for this to work.
-}
rsyncProgress :: (Integer -> IO ()) -> [CommandParam] -> IO Bool
-rsyncProgress callback params = catchBoolIO $
+rsyncProgress callback params =
withHandle StdoutHandle createProcessSuccess p (feedprogress 0 [])
where
p = proc "rsync" (toCommand params)
diff --git a/Utility/SafeCommand.hs b/Utility/SafeCommand.hs
index 19dd707b8..fbea7b6b2 100644
--- a/Utility/SafeCommand.hs
+++ b/Utility/SafeCommand.hs
@@ -49,8 +49,6 @@ boolSystemEnv command params environ = dispatch <$> safeSystemEnv command params
safeSystem :: FilePath -> [CommandParam] -> IO ExitCode
safeSystem command params = safeSystemEnv command params Nothing
-{- Unlike many implementations of system, SIGINT(ctrl-c) is allowed
- - to propigate and will terminate the program. -}
safeSystemEnv :: FilePath -> [CommandParam] -> Maybe [(String, String)] -> IO ExitCode
safeSystemEnv command params environ = do
(_, _, _, pid) <- createProcess (proc command $ toCommand params)
diff --git a/doc/bugs/signal_weirdness.mdwn b/doc/bugs/signal_weirdness.mdwn
index a7cc14642..1942a924a 100644
--- a/doc/bugs/signal_weirdness.mdwn
+++ b/doc/bugs/signal_weirdness.mdwn
@@ -14,7 +14,7 @@ For example:
Here git-annex exits before rsync has fully exited. Not a large problem
but sorta weird.
-The culprit is `safeSystemEnv` in Utility.SafeCommand, which installs
+The culprit is `CmdLine.startup` in Utility.SafeCommand, which installs
a default signal handler for SIGINT, which causes it to immediatly
terminate git-annex. rsync, in turn, has its own SIGINT handler, which
prints the message, typically later.