diff options
| -rw-r--r-- | Logs/Transfer.hs | 20 | ||||
| -rw-r--r-- | Utility/Daemon.hs | 15 | ||||
| -rw-r--r-- | Utility/PID.hs | 31 |
3 files changed, 46 insertions, 20 deletions
diff --git a/Logs/Transfer.hs b/Logs/Transfer.hs index e998a56b1..ebbb153ac 100644 --- a/Logs/Transfer.hs +++ b/Logs/Transfer.hs @@ -17,6 +17,10 @@ import Types.Key import Utility.Metered import Utility.Percentage import Utility.QuickCheck +import Utility.PID +#ifdef mingw32_HOST_OS +import Utility.WinLock +#endif import Data.Time.Clock import Data.Time.Clock.POSIX @@ -24,20 +28,6 @@ import Data.Time import System.Locale import Control.Concurrent -#ifndef mingw32_HOST_OS -import System.Posix.Types (ProcessID) -#else -import System.Win32.Process (ProcessId) -import System.Win32.Process.Current (getCurrentProcessId) -import Utility.WinLock -#endif - -#ifndef mingw32_HOST_OS -type PID = ProcessID -#else -type PID = ProcessId -#endif - {- Enough information to uniquely identify a transfer, used as the filename - of the transfer information file. -} data Transfer = Transfer @@ -231,7 +221,7 @@ startTransferInfo file = TransferInfo #ifndef mingw32_HOST_OS <*> pure Nothing -- pid not stored in file, so omitted for speed #else - <*> (Just <$> getCurrentProcessId) + <*> (Just <$> getPID) #endif <*> pure Nothing -- tid ditto <*> pure Nothing -- not 0; transfer may be resuming diff --git a/Utility/Daemon.hs b/Utility/Daemon.hs index 1654821af..970f26c3e 100644 --- a/Utility/Daemon.hs +++ b/Utility/Daemon.hs @@ -1,6 +1,6 @@ {- daemon support - - - Copyright 2012 Joey Hess <joey@kitenet.net> + - Copyright 2012-2014 Joey Hess <joey@kitenet.net> - - Licensed under the GNU GPL version 3 or higher. -} @@ -10,6 +10,7 @@ module Utility.Daemon where import Common +import Utility.PID #ifndef mingw32_HOST_OS import Utility.LogFile #endif @@ -19,6 +20,7 @@ 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 @@ -70,7 +72,7 @@ lockPidFile file = do (Nothing, _) -> alreadyRunning (_, Nothing) -> alreadyRunning _ -> do - _ <- fdWrite fd' =<< show <$> getProcessID + _ <- fdWrite fd' =<< show <$> getPID closeFd fd #else writeFile newfile "-1" @@ -86,7 +88,7 @@ alreadyRunning = error "Daemon is already running." - is locked by the same process that is listed in the pid file. - - If it's running, returns its pid. -} -checkDaemon :: FilePath -> IO (Maybe ProcessID) +checkDaemon :: FilePath -> IO (Maybe PID) #ifndef mingw32_HOST_OS checkDaemon pidfile = do v <- catchMaybeIO $ @@ -110,11 +112,14 @@ checkDaemon pidfile = do checkDaemon pidfile = maybe Nothing readish <$> catchMaybeIO (readFile pidfile) #endif -#ifndef mingw32_HOST_OS {- Stops the daemon, safely. -} stopDaemon :: FilePath -> IO () stopDaemon pidfile = go =<< checkDaemon pidfile where go Nothing = noop - go (Just pid) = signalProcess sigTERM pid + go (Just pid) = +#ifndef mingw32_HOST_OS + signalProcess sigTERM pid +#else + generateConsoleCtrlEvent cTRL_C_EVENT pid #endif diff --git a/Utility/PID.hs b/Utility/PID.hs new file mode 100644 index 000000000..4867bd6de --- /dev/null +++ b/Utility/PID.hs @@ -0,0 +1,31 @@ +{- process ids + - + - Copyright 2014 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +{-# LANGUAGE CPP #-} + +module Utility.PID where + +#ifndef mingw32_HOST_OS +import System.Posix.Types (ProcessID) +import System.Posix.Process (getProcessID) +#else +import System.Win32.Process (ProcessId) +import System.Win32.Process.Current (getCurrentProcessId) +#endif + +#ifndef mingw32_HOST_OS +type PID = ProcessID +#else +type PID = ProcessId +#endif + +getPID :: IO PID +#ifndef mingw32_HOST_OS +getPID = getProcessID +#else +getPID = getCurrentProcessId +#endif |