mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

different PID types for Unix and Windows

Browse source 
Windows has a larger (unsigned) PID space, so cannot use the unix CInt
there.

Note that TransferInfo does not yet ever get the TransferPid populated,
as there is missing locking.
This commit is contained in:
Joey Hess 2013-12-10 23:32:10 -04:00
parent 2fd63f3cfa
commit ecd42aef8e
2 changed files with 20 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
Assistant/TransferSlots.hs
View file

@ -260,13 +260,15 @@ cancelTransfer pause t = do
killproc pid = void $ tryIO $ do killproc pid = void $ tryIO $ do
#ifndef mingw32_HOST_OS #ifndef mingw32_HOST_OS
g <- getProcessGroupIDOf pid g <- getProcessGroupIDOf pid
void $ tryIO $ signalProcessGroup sigTERM g let signal sig = void $ tryIO $ signalProcessGroup sig g
signal sigTERM
graceperiod graceperiod
void $ tryIO $ signalProcessGroup sigKILL g signal sigKILL
#else #else
void $ tryIO $ generateConsoleCtrlEvent cTRL_C_EVENT pid let singnal sig = void $ tryIO $ generateConsoleCtrlEvent sig pid
signal cTRL_C_EVENT
graceperiod graceperiod
void $ tryIO $ generateConsoleCtrlEvent cTRL_BREAK_EVENT pid signal cTRL_BREAK_EVENT
#endif #endif
graceperiod = threadDelay 50000 -- 0.05 second graceperiod = threadDelay 50000 -- 0.05 second

18
Logs/Transfer.hs
View file

@ -18,13 +18,23 @@ import Utility.Metered
import Utility.Percentage import Utility.Percentage
import Utility.QuickCheck import Utility.QuickCheck
import System.Posix.Types #ifndef mingw32_HOST_OS
import System.Posix.Types (ProcessID)
#else
import System.Win32.Process (ProcessId)
#endif
import Data.Time.Clock import Data.Time.Clock
import Data.Time.Clock.POSIX import Data.Time.Clock.POSIX
import Data.Time import Data.Time
import System.Locale import System.Locale
import Control.Concurrent import Control.Concurrent
#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
@ -42,7 +52,7 @@ data Transfer = Transfer
-} -}
data TransferInfo = TransferInfo data TransferInfo = TransferInfo
{ startedTime :: Maybe POSIXTime { startedTime :: Maybe POSIXTime
, transferPid :: Maybe ProcessID , transferPid :: Maybe PID
, transferTid :: Maybe ThreadId , transferTid :: Maybe ThreadId
, transferRemote :: Maybe Remote , transferRemote :: Maybe Remote
, bytesComplete :: Maybe Integer , bytesComplete :: Maybe Integer
@ -328,13 +338,13 @@ writeTransferInfo info = unlines
, fromMaybe "" $ associatedFile info -- comes last; arbitrary content , fromMaybe "" $ associatedFile info -- comes last; arbitrary content
] ]
readTransferInfoFile :: Maybe ProcessID -> FilePath -> IO (Maybe TransferInfo) readTransferInfoFile :: Maybe PID -> FilePath -> IO (Maybe TransferInfo)
readTransferInfoFile mpid tfile = catchDefaultIO Nothing $ do readTransferInfoFile mpid tfile = catchDefaultIO Nothing $ do
h <- openFile tfile ReadMode h <- openFile tfile ReadMode
fileEncoding h fileEncoding h
hClose h `after` (readTransferInfo mpid <$> hGetContentsStrict h) hClose h `after` (readTransferInfo mpid <$> hGetContentsStrict h)
readTransferInfo :: Maybe ProcessID -> String -> Maybe TransferInfo readTransferInfo :: Maybe PID -> String -> Maybe TransferInfo
readTransferInfo mpid s = TransferInfo readTransferInfo mpid s = TransferInfo
<$> time <$> time
<*> pure mpid <*> pure mpid