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.

Assistant/Restart.hs

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

Assistant/WebApp/Control.hs

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

Command/Fsck.hs

@@ -38,7 +38,7 @@ import GitAnnex.Options hiding (fromOption)
 #ifndef mingw32_HOST_OS
 import System.Posix.Process (getProcessID)
 #else
-import System.Random (getStdRandom, random)
+import System.Win32.Process.Current (getCurrentProcessId)
 #endif
 import Data.Time.Clock.POSIX
 import Data.Time
@@ -154,7 +154,7 @@ performRemote key file backend numcopies remote =
 #ifndef mingw32_HOST_OS
 		v <- liftIO getProcessID
 #else
-		v <- liftIO (getStdRandom random :: IO Int)
+		v <- liftIO getCurrentProcessId
 #endif
 		t <- fromRepo gitAnnexTmpDir
 		createAnnexDirectory t

Logs/Transfer.hs

@@ -18,17 +18,19 @@ import Utility.Metered
 import Utility.Percentage
 import Utility.QuickCheck
 
-#ifndef mingw32_HOST_OS
-import System.Posix.Types (ProcessID)
-#else
-import System.Win32.Process (ProcessId)
-#endif
 import Data.Time.Clock
 import Data.Time.Clock.POSIX
 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)
+#endif
+
 #ifndef mingw32_HOST_OS
 type PID = ProcessID
 #else
@@ -214,7 +216,11 @@ mkProgressUpdater t info = do
 startTransferInfo :: Maybe FilePath -> IO TransferInfo
 startTransferInfo file = TransferInfo
 	<$> (Just . utcTimeToPOSIXSeconds <$> getCurrentTime)
+#ifndef mingw32_HOST_OS
 	<*> pure Nothing -- pid not stored in file, so omitted for speed
+#else
+	<*> (Just <$> getCurrentProcessId)
+#endif
 	<*> pure Nothing -- tid ditto
 	<*> pure Nothing -- not 0; transfer may be resuming
 	<*> pure Nothing
@@ -328,13 +334,18 @@ writeTransferInfoFile info tfile = do
 {- File format is a header line containing the startedTime and any
  - bytesComplete value. Followed by a newline and the associatedFile.
  -
- - The transferPid is not included; instead it is obtained by looking
- - at the process that locks the file.
+ - On unix, the transferPid is not included; instead it is obtained
+ - by looking at the process that locks the file.
+ -
+ - On windows, the transferPid is included, as a second line.
  -}
 writeTransferInfo :: TransferInfo -> String
 writeTransferInfo info = unlines
 	[ (maybe "" show $ startedTime info) ++
 	  (maybe "" (\b -> ' ' : show b) (bytesComplete info))
+#ifdef mingw32_HOST_OS
+	, maybe "" show (transferPid info)
+#endif
 	, fromMaybe "" $ associatedFile info -- comes last; arbitrary content
 	]
 
@@ -347,14 +358,24 @@ readTransferInfoFile mpid tfile = catchDefaultIO Nothing $ do
 readTransferInfo :: Maybe PID -> String -> Maybe TransferInfo
 readTransferInfo mpid s = TransferInfo
 	<$> time
+#ifdef mingw32_HOST_OS
+	<*> pure $ if isJust mpid then mpid else mpid'
+#else
 	<*> pure mpid
+#endif
 	<*> pure Nothing
 	<*> pure Nothing
 	<*> bytes
 	<*> pure (if null filename then Nothing else Just filename)
 	<*> pure False
   where
+#ifdef mingw32_HOST_OS
+	(firstline, rem) = separate (== '\n') s
+	(secondline, rest) = separate (== '\n') rem
+	mpid' = readish secondline
+#else
 	(firstline, rest) = separate (== '\n') s
+#endif
 	filename
 		| end rest == "\n" = beginning rest
 		| otherwise = rest

Remote/Rsync.hs

@@ -23,7 +23,7 @@ import qualified Data.Map as M
 #ifndef mingw32_HOST_OS
 import System.Posix.Process (getProcessID)
 #else
-import System.Random (getStdRandom, random)
+import System.Win32.Process.Current (getCurrentProcessId)
 #endif
 
 import Common.Annex
@@ -243,7 +243,7 @@ withRsyncScratchDir a = do
 #ifndef mingw32_HOST_OS
 	v <- liftIO getProcessID
 #else
-	v <- liftIO (getStdRandom random :: IO Int)
+	v <- liftIO getCurrentProcessId
 #endif
 	t <- fromRepo gitAnnexTmpDir
 	createAnnexDirectory t

git-annex.cabal

@@ -101,7 +101,7 @@ Executable git-annex
     GHC-Options: -O2
 
   if (os(windows))
-    Build-Depends: Win32
+    Build-Depends: Win32, Win32-extras
   else
     Build-Depends: unix
     -- Need to list these because they're generated from .hsc files.