{-# LANGUAGE CPP #-} #if defined(mingw32_HOST_OS) || defined(__MINGW32__) {-# LANGUAGE ForeignFunctionInterface #-} #if defined(i386_HOST_ARCH) #define WINDOWS_CCONV stdcall #elif defined(x86_64_HOST_ARCH) #define WINDOWS_CCONV ccall #else #error Unknown mingw32 arch #endif #endif {- | Compatibility code for things that need to be done differently on different systems. -} module Config.Dyre.Compat ( customExec, getPIDString ) where import Config.Dyre.Options ( customOptions ) #if defined(mingw32_HOST_OS) || defined(__MINGW32__) -- Windows import System.Win32 import System.Process import System.Exit import System.Mem -- This can be removed as soon as a 'getProcessID' function -- gets added to 'System.Win32' foreign import WINDOWS_CCONV unsafe "winbase.h GetCurrentProcessId" c_GetCurrentProcessID :: IO DWORD getPIDString = fmap show c_GetCurrentProcessID customExec binary mArgs = do args <- customOptions mArgs -- This whole thing is a terrible, ugly hack. Since Windows -- is too braindead to provide an exec() system call for us -- to use, we simply create a new process that inherits -- the stdio handles. (_,_,_,child) <- createProcess $ proc binary args -- Do some garbage collection in an optimistic attempt to -- offset some of the memory we waste here. performGC -- And to prevent terminal apps from losing IO, we have to -- sit around waiting for the child to exit. -- -- 'exitWith' will flush stdout and stderr waitForProcess child >>= exitWith #else import System.Posix.Process ( executeFile, getProcessID ) #ifdef darwin_HOST_OS import System.Posix.Process ( exitImmediately , forkProcess, getProcessStatus, ProcessStatus(..) ) import System.Posix.Signals ( raiseSignal, sigTSTP ) import System.Exit ( ExitCode(ExitSuccess) ) -- OSX. In a threaded process execv fails with ENOTSUP. -- See http://uninformed.org/index.cgi?v=1&a=1&p=16. So it -- is necessary to fork _then_ exec. -- -- According to https://bugs.python.org/issue6800 this was -- fixed in OS X 10.6. But I guess we'll leave the workaround -- in place until there is a compelling reason to remove it. customExec binary mArgs = do args <- customOptions mArgs childPID <- forkProcess $ executeFile binary False args Nothing forever $ do childStatus <- getProcessStatus True True childPID case childStatus of Nothing -> error "executeFile: couldn't get child process status" Just (Exited code) -> exitImmediately code #if MIN_VERSION_unix(2,7,0) Just (Terminated _ _) -> exitImmediately ExitSuccess #else Just (Terminated _) -> exitImmediately ExitSuccess #endif Just (Stopped _) -> raiseSignal sigTSTP where forever a = a >> forever a #else -- Linux / BSD customExec binary mArgs = do args <- customOptions mArgs executeFile binary False args Nothing #endif getPIDString = fmap show getProcessID #endif -- | Called whenever execution needs to be transferred over to -- a different binary. customExec :: FilePath -> Maybe [String] -> IO a -- | What it says on the tin. Gets the current PID as a string. -- Used to determine the name for the state file during restarts. getPIDString :: IO String