diff options
| -rw-r--r-- | Command/Fsck.hs | 4 | ||||
| -rw-r--r-- | Logs/Transfer.hs | 35 | ||||
| -rw-r--r-- | Remote/Rsync.hs | 4 | ||||
| -rw-r--r-- | git-annex.cabal | 2 |
4 files changed, 33 insertions, 12 deletions
diff --git a/Command/Fsck.hs b/Command/Fsck.hs index d3a8b3083..2ab47b562 100644 --- a/Command/Fsck.hs +++ b/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 diff --git a/Logs/Transfer.hs b/Logs/Transfer.hs index b96b827c6..a278fce35 100644 --- a/Logs/Transfer.hs +++ b/Logs/Transfer.hs @@ -18,11 +18,6 @@ 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 @@ -30,6 +25,13 @@ 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 type PID = ProcessId @@ -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 diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs index 627690d2b..fd00d4674 100644 --- a/Remote/Rsync.hs +++ b/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 diff --git a/git-annex.cabal b/git-annex.cabal index 789ded518..3d1c0b211 100644 --- a/git-annex.cabal +++ b/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. |