diff options
| -rw-r--r-- | Assistant.hs | 3 | ||||
| -rw-r--r-- | Assistant/TransferSlots.hs | 16 | ||||
| -rw-r--r-- | Build/EvilLinker.hs | 11 | ||||
| -rw-r--r-- | Utility/Daemon.hs | 9 | ||||
| -rw-r--r-- | Utility/WinProcess.hs | 19 | ||||
| -rw-r--r-- | Utility/winprocess.c | 10 | ||||
| -rw-r--r-- | doc/todo/windows_support.mdwn | 5 | ||||
| -rw-r--r-- | git-annex.cabal | 1 |
8 files changed, 54 insertions, 20 deletions
diff --git a/Assistant.hs b/Assistant.hs index 800a3ef78..c66a1b73b 100644 --- a/Assistant.hs +++ b/Assistant.hs @@ -93,7 +93,8 @@ startDaemon assistant foreground startdelay cannotrun listenhost startbrowser = start (Utility.Daemon.daemonize logfd (Just pidfile) False) Nothing #else -- Windows is always foreground, and has no log file. - start id $ + liftIO $ Utility.Daemon.lockPidFile pidfile + start id $ do case startbrowser of Nothing -> Nothing Just a -> Just $ a Nothing Nothing diff --git a/Assistant/TransferSlots.hs b/Assistant/TransferSlots.hs index de96cdf85..a36a3ee32 100644 --- a/Assistant/TransferSlots.hs +++ b/Assistant/TransferSlots.hs @@ -39,7 +39,7 @@ import qualified Control.Concurrent.MSemN as MSemN import System.Posix.Process (getProcessGroupIDOf) import System.Posix.Signals (signalProcessGroup, sigTERM, sigKILL) #else -import System.Win32.Console (generateConsoleCtrlEvent, cTRL_C_EVENT, cTRL_BREAK_EVENT) +import Utility.WinProcess #endif type TransferGenerator = Assistant (Maybe (Transfer, TransferInfo, Transferrer -> Assistant ())) @@ -256,23 +256,19 @@ 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 let signal sig = void $ tryIO $ signalProcessGroup sig g signal sigTERM - graceperiod + threadDelay 50000 -- 0.05 second grace period signal sigKILL #else - let signal sig = void $ tryIO $ generateConsoleCtrlEvent sig pid - signal cTRL_C_EVENT - graceperiod - signal cTRL_BREAK_EVENT + terminatePID pid #endif - graceperiod = threadDelay 50000 -- 0.05 second {- Start or resume a transfer. -} startTransfer :: Transfer -> Assistant () diff --git a/Build/EvilLinker.hs b/Build/EvilLinker.hs index c8641f649..1b57ba959 100644 --- a/Build/EvilLinker.hs +++ b/Build/EvilLinker.hs @@ -17,6 +17,7 @@ import Control.Applicative ((<$>)) import Control.Monad import System.Directory import Data.Maybe +import Data.List import Utility.Monad import Utility.Process @@ -94,13 +95,19 @@ parseCollect2 = do path <- manyTill anyChar (try $ string ldcmd) void $ char ' ' params <- restOfLine - return $ CmdParams (path ++ ldcmd) (escapeDosPaths params) Nothing + return $ CmdParams (path ++ ldcmd) (skipHack $ escapeDosPaths params) Nothing where ldcmd = "ld.exe" versionline = do void $ string "collect2 version" restOfLine - + +{- For unknown reasons, asking the linker to link this in fails, + - with error about multiple definitions of a symbol from the library. + - This is a horrible hack. -} +skipHack :: String -> String +skipHack = replace "dist/build/git-annex/git-annex-tmp/Utility/winprocess.o" "" + {- Input contains something like - c:/program files/haskell platform/foo -LC:/Program Files/Haskell Platform/ -L... - and the *right* spaces must be escaped with \ diff --git a/Utility/Daemon.hs b/Utility/Daemon.hs index a3a8dbb51..c10e87192 100644 --- a/Utility/Daemon.hs +++ b/Utility/Daemon.hs @@ -13,14 +13,13 @@ import Common import Utility.PID #ifndef mingw32_HOST_OS import Utility.LogFile +#else +import Utility.WinProcess #endif #ifndef mingw32_HOST_OS import System.Posix import Control.Concurrent.Async -#else -import System.PosixCompat.Types -import System.Win32.Console (generateConsoleCtrlEvent, cTRL_C_EVENT) #endif #ifndef mingw32_HOST_OS @@ -75,7 +74,7 @@ lockPidFile file = do _ <- fdWrite fd' =<< show <$> getPID closeFd fd #else - writeFile newfile "-1" + writeFile newfile . show =<< getPID #endif rename newfile file where @@ -121,5 +120,5 @@ stopDaemon pidfile = go =<< checkDaemon pidfile #ifndef mingw32_HOST_OS signalProcess sigTERM pid #else - generateConsoleCtrlEvent cTRL_C_EVENT pid + terminatePID pid #endif diff --git a/Utility/WinProcess.hs b/Utility/WinProcess.hs new file mode 100644 index 000000000..5c6d4cfce --- /dev/null +++ b/Utility/WinProcess.hs @@ -0,0 +1,19 @@ +{- Windows processes + - + - Copyright 2014 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +{-# LANGUAGE ForeignFunctionInterface #-} + +module Utility.WinProcess where + +import Utility.PID + +import System.Win32.Process +import Foreign.C +import Control.Exception + +foreign import ccall unsafe "terminatepid" + terminatePID :: PID -> IO () diff --git a/Utility/winprocess.c b/Utility/winprocess.c new file mode 100644 index 000000000..b6e315573 --- /dev/null +++ b/Utility/winprocess.c @@ -0,0 +1,10 @@ +#include <windows.h> + +void terminatepid (DWORD pid) { + HANDLE h; + h = OpenProcess(PROCESS_TERMINATE, 0, pid); + if (h != NULL) { + TerminateProcess(h, 1); + } + CloseHandle(h); +} diff --git a/doc/todo/windows_support.mdwn b/doc/todo/windows_support.mdwn index c19d7068a..87a39acf2 100644 --- a/doc/todo/windows_support.mdwn +++ b/doc/todo/windows_support.mdwn @@ -53,11 +53,12 @@ now! --[[Joey]] * Deleting a git repository from inside the webapp fails "RemoveDirectory permision denined ... file is being used by another process" * Shutting down the webapp does not stop the daemon; the ctrl-c hack - doesn't work. + doesn't work. (Restarting the daemon also does not stop the old process, + same reason.) ## stuff needing testing * test S3 and box.com setup in webapp now that they should work.. * test that adding a repo on a removable drive works; that git is synced to it and files can be transferred to it and back - +* Does stopping in progress transfers work in the webapp? diff --git a/git-annex.cabal b/git-annex.cabal index b149f2cdf..d982b6d06 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -105,6 +105,7 @@ Executable git-annex if (os(windows)) Build-Depends: Win32, Win32-extras + C-Sources: Utility/winprocess.c else Build-Depends: unix -- Need to list these because they're generated from .hsc files. |