fix windows build (and make --stop work on windows, incidentially)

The Utility.PID will clean up other code soon.
This commit is contained in:
Joey Hess 2014-02-11 15:22:08 -04:00
parent 30a474b309
commit c390e896d1
3 changed files with 46 additions and 20 deletions

View file

@ -17,6 +17,10 @@ import Types.Key
import Utility.Metered import Utility.Metered
import Utility.Percentage import Utility.Percentage
import Utility.QuickCheck import Utility.QuickCheck
import Utility.PID
#ifdef mingw32_HOST_OS
import Utility.WinLock
#endif
import Data.Time.Clock import Data.Time.Clock
import Data.Time.Clock.POSIX import Data.Time.Clock.POSIX
@ -24,20 +28,6 @@ import Data.Time
import System.Locale import System.Locale
import Control.Concurrent 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 {- Enough information to uniquely identify a transfer, used as the filename
- of the transfer information file. -} - of the transfer information file. -}
data Transfer = Transfer data Transfer = Transfer
@ -231,7 +221,7 @@ startTransferInfo file = TransferInfo
#ifndef mingw32_HOST_OS #ifndef mingw32_HOST_OS
<*> pure Nothing -- pid not stored in file, so omitted for speed <*> pure Nothing -- pid not stored in file, so omitted for speed
#else #else
<*> (Just <$> getCurrentProcessId) <*> (Just <$> getPID)
#endif #endif
<*> pure Nothing -- tid ditto <*> pure Nothing -- tid ditto
<*> pure Nothing -- not 0; transfer may be resuming <*> pure Nothing -- not 0; transfer may be resuming

View file

@ -1,6 +1,6 @@
{- daemon support {- 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. - Licensed under the GNU GPL version 3 or higher.
-} -}
@ -10,6 +10,7 @@
module Utility.Daemon where module Utility.Daemon where
import Common import Common
import Utility.PID
#ifndef mingw32_HOST_OS #ifndef mingw32_HOST_OS
import Utility.LogFile import Utility.LogFile
#endif #endif
@ -19,6 +20,7 @@ import System.Posix
import Control.Concurrent.Async import Control.Concurrent.Async
#else #else
import System.PosixCompat.Types import System.PosixCompat.Types
import System.Win32.Console (generateConsoleCtrlEvent, cTRL_C_EVENT
#endif #endif
#ifndef mingw32_HOST_OS #ifndef mingw32_HOST_OS
@ -70,7 +72,7 @@ lockPidFile file = do
(Nothing, _) -> alreadyRunning (Nothing, _) -> alreadyRunning
(_, Nothing) -> alreadyRunning (_, Nothing) -> alreadyRunning
_ -> do _ -> do
_ <- fdWrite fd' =<< show <$> getProcessID _ <- fdWrite fd' =<< show <$> getPID
closeFd fd closeFd fd
#else #else
writeFile newfile "-1" 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. - is locked by the same process that is listed in the pid file.
- -
- If it's running, returns its pid. -} - If it's running, returns its pid. -}
checkDaemon :: FilePath -> IO (Maybe ProcessID) checkDaemon :: FilePath -> IO (Maybe PID)
#ifndef mingw32_HOST_OS #ifndef mingw32_HOST_OS
checkDaemon pidfile = do checkDaemon pidfile = do
v <- catchMaybeIO $ v <- catchMaybeIO $
@ -110,11 +112,14 @@ checkDaemon pidfile = do
checkDaemon pidfile = maybe Nothing readish <$> catchMaybeIO (readFile pidfile) checkDaemon pidfile = maybe Nothing readish <$> catchMaybeIO (readFile pidfile)
#endif #endif
#ifndef mingw32_HOST_OS
{- Stops the daemon, safely. -} {- Stops the daemon, safely. -}
stopDaemon :: FilePath -> IO () stopDaemon :: FilePath -> IO ()
stopDaemon pidfile = go =<< checkDaemon pidfile stopDaemon pidfile = go =<< checkDaemon pidfile
where where
go Nothing = noop 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 #endif

31
Utility/PID.hs Normal file
View file

@ -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