diff options
| -rw-r--r-- | Annex.hs | 4 | ||||
| -rw-r--r-- | Annex/Journal.hs | 13 | ||||
| -rw-r--r-- | Annex/LockPool.hs | 32 | ||||
| -rw-r--r-- | Logs/Transfer.hs | 39 | ||||
| -rw-r--r-- | Remote/Helper/Hooks.hs | 11 | ||||
| -rw-r--r-- | Types/LockPool.hs | 24 | ||||
| -rw-r--r-- | Utility/WinLock.hs | 5 | ||||
| -rw-r--r-- | debian/changelog | 7 |
8 files changed, 95 insertions, 40 deletions
@@ -34,7 +34,6 @@ module Annex ( import "mtl" Control.Monad.Reader import "MonadCatchIO-transformers" Control.Monad.CatchIO -import System.Posix.Types (Fd) import Control.Concurrent import Common @@ -58,6 +57,7 @@ import Types.Messages import Types.UUID import Types.FileMatcher import Types.NumCopies +import Types.LockPool import qualified Utility.Matcher import qualified Data.Map as M import qualified Data.Set as S @@ -106,7 +106,7 @@ data AnnexState = AnnexState , trustmap :: Maybe TrustMap , groupmap :: Maybe GroupMap , ciphers :: M.Map StorableCipher Cipher - , lockpool :: M.Map FilePath Fd + , lockpool :: LockPool , flags :: M.Map String Bool , fields :: M.Map String String , cleanup :: M.Map String (Annex ()) diff --git a/Annex/Journal.hs b/Annex/Journal.hs index 8b88ab2fb..3f31cb941 100644 --- a/Annex/Journal.hs +++ b/Annex/Journal.hs @@ -20,6 +20,10 @@ import Annex.Exception import qualified Git import Annex.Perms +#ifdef mingw32_HOST_OS +import Utility.WinLock +#endif + {- Records content for a file in the branch to the journal. - - Using the journal, rather than immediatly staging content to the index @@ -116,13 +120,8 @@ lockJournal a = do l <- noUmask mode $ createFile lockfile mode waitToSetLock l (WriteLock, AbsoluteSeek, 0, 0) return l -#else - lock lockfile _mode = do - writeFile lockfile "" - return lockfile -#endif -#ifndef mingw32_HOST_OS unlock = closeFd #else - unlock = removeFile + lock lockfile _mode = waitToLock $ lockExclusive lockfile + unlock = dropLock #endif diff --git a/Annex/LockPool.hs b/Annex/LockPool.hs index a9a0f3101..5fc167d28 100644 --- a/Annex/LockPool.hs +++ b/Annex/LockPool.hs @@ -1,6 +1,6 @@ {- git-annex lock pool - - - Copyright 2012 Joey Hess <joey@kitenet.net> + - Copyright 2012, 2014 Joey Hess <joey@kitenet.net> - - Licensed under the GNU GPL version 3 or higher. -} @@ -9,13 +9,16 @@ module Annex.LockPool where -import qualified Data.Map as M -import System.Posix.Types (Fd) - import Common.Annex import Annex +import Types.LockPool + +import qualified Data.Map as M + #ifndef mingw32_HOST_OS import Annex.Perms +#else +import Utility.WinLock #endif {- Create a specified lock file, and takes a shared lock. -} @@ -26,31 +29,32 @@ lockFile file = go =<< fromPool file go Nothing = do #ifndef mingw32_HOST_OS mode <- annexFileMode - fd <- liftIO $ noUmask mode $ + lockhandle <- liftIO $ noUmask mode $ openFd file ReadOnly (Just mode) defaultFileFlags - liftIO $ waitToSetLock fd (ReadLock, AbsoluteSeek, 0, 0) + liftIO $ waitToSetLock lockhandle (ReadLock, AbsoluteSeek, 0, 0) #else - liftIO $ writeFile file "" - let fd = 0 + lockhandle <- liftIO $ waitToLock $ lockShared file #endif - changePool $ M.insert file fd + changePool $ M.insert file lockhandle unlockFile :: FilePath -> Annex () unlockFile file = maybe noop go =<< fromPool file where - go fd = do + go lockhandle = do #ifndef mingw32_HOST_OS - liftIO $ closeFd fd + liftIO $ closeFd lockhandle +#else + liftIO $ dropLock lockhandle #endif changePool $ M.delete file -getPool :: Annex (M.Map FilePath Fd) +getPool :: Annex LockPool getPool = getState lockpool -fromPool :: FilePath -> Annex (Maybe Fd) +fromPool :: FilePath -> Annex (Maybe LockHandle) fromPool file = M.lookup file <$> getPool -changePool :: (M.Map FilePath Fd -> M.Map FilePath Fd) -> Annex () +changePool :: (LockPool -> LockPool) -> Annex () changePool a = do m <- getPool changeState $ \s -> s { lockpool = a m } diff --git a/Logs/Transfer.hs b/Logs/Transfer.hs index 97ec08895..39cae1106 100644 --- a/Logs/Transfer.hs +++ b/Logs/Transfer.hs @@ -29,6 +29,7 @@ import System.Posix.Types (ProcessID) #else import System.Win32.Process (ProcessId) import System.Win32.Process.Current (getCurrentProcessId) +import Utility.WinLock #endif #ifndef mingw32_HOST_OS @@ -147,7 +148,7 @@ runTransfer t file shouldretry a = do openFd (transferLockFile tfile) ReadWrite (Just mode) defaultFileFlags { trunc = True } case mfd of - Nothing -> return (mfd, False) + Nothing -> return (Nothing, False) Just fd -> do locked <- catchMaybeIO $ setLock fd (WriteLock, AbsoluteSeek, 0, 0) @@ -158,17 +159,28 @@ runTransfer t file shouldretry a = do return (mfd, False) #else prep tfile _mode info = do - mfd <- catchMaybeIO $ do - writeFile (transferLockFile tfile) "" - writeTransferInfoFile info tfile - return (mfd, False) + v <- catchMaybeIO $ lockExclusive (transferLockFile tfile) + case v of + Nothing -> return (Nothing, False) + Just Nothing -> return (Nothing, True) + Just (Just lockhandle) -> do + void $ tryIO $ writeTransferInfoFile info tfile + return (Just lockhandle, False) #endif cleanup _ Nothing = noop - cleanup tfile (Just fd) = do + cleanup tfile (Just lockhandle) = do void $ tryIO $ removeFile tfile - void $ tryIO $ removeFile $ transferLockFile tfile #ifndef mingw32_HOST_OS - closeFd fd + void $ tryIO $ removeFile $ transferLockFile tfile + closeFd lockhandle +#else + {- Windows cannot delete the lockfile until the lock + - is closed. So it's possible to race with another + - process that takes the lock before it's removed, + - so ignore failure to remove. + -} + dropLock lockhandle + void $ tryIO $ removeFile $ transferLockFile tfile #endif retry oldinfo metervar run = do v <- tryAnnex run @@ -246,11 +258,14 @@ checkTransfer t = do Just (pid, _) -> liftIO $ catchDefaultIO Nothing $ readTransferInfoFile (Just pid) tfile #else - ifM (liftIO $ doesFileExist $ transferLockFile tfile) - ( liftIO $ catchDefaultIO Nothing $ + v <- liftIO $ lockShared $ transferLockFile tfile + liftIO $ case v of + Nothing -> catchDefaultIO Nothing $ readTransferInfoFile Nothing tfile - , return Nothing - ) + Just lockhandle -> do + dropLock lockhandle + void $ tryIO $ removeFile $ transferLockFile tfile + return Nothing #endif {- Gets all currently running transfers. -} diff --git a/Remote/Helper/Hooks.hs b/Remote/Helper/Hooks.hs index 91c6318bf..f876649f0 100644 --- a/Remote/Helper/Hooks.hs +++ b/Remote/Helper/Hooks.hs @@ -17,6 +17,8 @@ import qualified Annex import Annex.LockPool #ifndef mingw32_HOST_OS import Annex.Perms +#else +import Utility.WinLock #endif {- Modifies a remote's access functions to first run the @@ -73,13 +75,13 @@ runHooks r starthook stophook a = do run starthook Annex.addCleanup (remoteid ++ "-stop-command") $ runstop lck -#ifndef mingw32_HOST_OS runstop lck = do -- Drop any shared lock we have, and take an -- exclusive lock, without blocking. If the lock -- succeeds, we're the only process using this remote, -- so can stop it. unlockFile lck +#ifndef mingw32_HOST_OS mode <- annexFileMode fd <- liftIO $ noUmask mode $ openFd lck ReadWrite (Just mode) defaultFileFlags @@ -90,5 +92,10 @@ runHooks r starthook stophook a = do Right _ -> run stophook liftIO $ closeFd fd #else - runstop _lck = run stophook + v <- liftIO $ lockExclusive lck + case v of + Nothing -> noop + Just lockhandle -> do + run stophook + liftIO $ dropLock lockhandle #endif diff --git a/Types/LockPool.hs b/Types/LockPool.hs new file mode 100644 index 000000000..dd392f28b --- /dev/null +++ b/Types/LockPool.hs @@ -0,0 +1,24 @@ +{- git-annex lock pool data types + - + - Copyright 2014 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +{-# LANGUAGE CPP #-} + +module Types.LockPool ( + LockPool, + LockHandle +) where + +import qualified Data.Map as M + +#ifndef mingw32_HOST_OS +import System.Posix.Types (Fd) +type LockHandle = Fd +#else +import Utility.WinLock -- defines LockHandle +#endif + +type LockPool = M.Map FilePath LockHandle diff --git a/Utility/WinLock.hs b/Utility/WinLock.hs index ebdba2b85..7b7cf7132 100644 --- a/Utility/WinLock.hs +++ b/Utility/WinLock.hs @@ -9,11 +9,10 @@ module Utility.WinLock ( lockShared, lockExclusive, dropLock, - waitToLock + waitToLock, + LockHandle ) where -import Common - import System.Win32.Types import System.Win32.File import Control.Concurrent diff --git a/debian/changelog b/debian/changelog index 894f92e42..f6eec27e1 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,10 @@ +git-annex (5.20140128) UNRELEASED; urgency=medium + + * Windows: It's now safe to run multiple git-annex processes concurrently + on Windows; the lock files have been sorted out. + + -- Joey Hess <joeyh@debian.org> Tue, 28 Jan 2014 13:57:19 -0400 + git-annex (5.20140127) unstable; urgency=medium * sync --content: New option that makes the content of annexed files be |