pull in Win32-extras, to be able to get current process id in Windows

Fixed up a number of things that had worked around there not being a way to
get that.

Most notably, transfer info files on windows now include the process id,
since no locking is currently done. This means the file format varies
between windows and unix.
This commit is contained in:
Joey Hess 2013-12-11 00:15:10 -04:00
parent c01af6285f
commit 011b8bc7ec
6 changed files with 46 additions and 19 deletions

View file

@ -26,6 +26,9 @@ import Control.Concurrent
import System.Process (cwd)
#ifndef mingw32_HOST_OS
import System.Posix (getProcessID, signalProcess, sigTERM)
#else
import System.Win32.Process.Current (getCurrentProcessId)
import System.Win32.Console (generateConsoleCtrlEvent, cTRL_C_EVENT)
#endif
{- Before the assistant can be restarted, have to remove our
@ -45,14 +48,14 @@ prepRestart = do
- Wait for browser to update before terminating this process. -}
postRestart :: URLString -> Assistant ()
postRestart url = do
#ifndef mingw32_HOST_OS
modifyDaemonStatus_ $ \status -> status { globalRedirUrl = Just url }
liftIO . sendNotification . globalRedirNotifier =<< getDaemonStatus
void $ liftIO $ forkIO $ do
threadDelaySeconds (Seconds 120)
#ifndef mingw32_HOST_OS
signalProcess sigTERM =<< getProcessID
#else
error "TODO windows postRestart"
generateConsoleCtrlEvent cTRL_C_EVENT =<< getCurrentProcessId
#endif
runRestart :: Assistant URLString

View file

@ -18,11 +18,14 @@ import Utility.LogFile
import Utility.NotificationBroadcaster
import Control.Concurrent
#ifndef mingw32_HOST_OS
import System.Posix (getProcessID, signalProcess, sigTERM)
#endif
import qualified Data.Map as M
import qualified Data.Text as T
#ifndef mingw32_HOST_OS
import System.Posix (getProcessID, signalProcess, sigTERM)
#else
import System.Win32.Process.Current (getCurrentProcessId)
import System.Win32.Console (generateConsoleCtrlEvent, cTRL_C_EVENT)
#endif
getShutdownR :: Handler Html
getShutdownR = page "Shutdown" Nothing $
@ -46,14 +49,14 @@ getShutdownConfirmedR = do
liftAssistant $ do
modifyDaemonStatus_ $ \status -> status { globalRedirUrl = Just url }
liftIO . sendNotification . globalRedirNotifier =<< getDaemonStatus
#ifndef mingw32_HOST_OS
{- Wait 2 seconds before shutting down, to give the web
- page time to load in the browser. -}
void $ liftIO $ forkIO $ do
threadDelay 2000000
#ifndef mingw32_HOST_OS
signalProcess sigTERM =<< getProcessID
#else
void $ liftIO exitSuccess
generateConsoleCtrlEvent cTRL_C_EVENT =<< getCurrentProcessId
#endif
redirect NotRunningR