aboutsummaryrefslogtreecommitdiff
path: root/Assistant/TransferSlots.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-12-10 23:19:18 -0400
committerGravatar Joey Hess <joey@kitenet.net>2013-12-10 23:19:18 -0400
commitf864a68220a0d77b5b6a5c3f4f25743e8e76aae0 (patch)
tree3e9006aa151b5c8e2ba8562aeefbd6db23cde69f /Assistant/TransferSlots.hs
parent180115645b86580d9077e95504b029152de15fa2 (diff)
port transferkeys to windows; make stopping in progress transfers work too (probably)
transferkeys had used special FDs for communication, but that would be quite annoying to do in Windows. Instead, use stdin and stdout. But, to avoid commands like rsync stomping on them and messing up the communications channel, they're duplicated to a different handle; stdin is replaced with a null handle, and stdout is replaced with a copy of stderr. This should all work in windows too. Stopping in progress transfers may work on windows.. if the types unify anyway. ;) May need some more porting.
Diffstat (limited to 'Assistant/TransferSlots.hs')
-rw-r--r--Assistant/TransferSlots.hs15
1 files changed, 10 insertions, 5 deletions
diff --git a/Assistant/TransferSlots.hs b/Assistant/TransferSlots.hs
index 4852c36f8..da92bbf0b 100644
--- a/Assistant/TransferSlots.hs
+++ b/Assistant/TransferSlots.hs
@@ -38,6 +38,8 @@ import qualified Control.Concurrent.MSemN as MSemN
#ifndef mingw32_HOST_OS
import System.Posix.Process (getProcessGroupIDOf)
import System.Posix.Signals (signalProcessGroup, sigTERM, sigKILL)
+#else
+import System.Win32.Console (generateConsoleCtrlEvent, cTRL_C_EVENT, cTRL_BREAK_EVENT)
#endif
type TransferGenerator = Assistant (Maybe (Transfer, TransferInfo, Transferrer -> Assistant ()))
@@ -252,18 +254,21 @@ cancelTransfer pause t = do
signalthread tid
| pause = throwTo tid PauseTransfer
| otherwise = killThread tid
+ {- In order to stop helper processes like rsync,
+ - kill the whole process group of the process
+ - running the transfer. -}
killproc pid = void $ tryIO $ do
#ifndef mingw32_HOST_OS
- {- In order to stop helper processes like rsync,
- - kill the whole process group of the process
- - running the transfer. -}
g <- getProcessGroupIDOf pid
void $ tryIO $ signalProcessGroup sigTERM g
- threadDelay 50000 -- 0.05 second grace period
+ graceperiod
void $ tryIO $ signalProcessGroup sigKILL g
#else
- error "TODO: cancelTransfer not implemented on Windows"
+ void $ tryIO $ generateConsoleCtrlEvent cTRL_C_EVENT pid
+ graceperiod
+ void $ tryIO $ generateConsoleCtrlEvent cTRL_BREAK_EVENT pid
#endif
+ graceperiod = threadDelay 50000 -- 0.05 second
{- Start or resume a transfer. -}
startTransfer :: Transfer -> Assistant ()