diff options
author | Joey Hess <joeyh@joeyh.name> | 2015-11-12 18:05:45 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2015-11-12 18:13:37 -0400 |
commit | 6b074fb7e741020b81d696bd66e62f75fd472966 (patch) | |
tree | 284ac39d6ce641c255555e504c89a9f4d9956744 | |
parent | 549f635c6b64006b5a369795805d08b8f439d54c (diff) |
convert from Utility.LockPool to Annex.LockPool everywhere
-rw-r--r-- | Annex/Content.hs | 16 | ||||
-rw-r--r-- | Annex/LockFile.hs | 12 | ||||
-rw-r--r-- | Annex/LockPool/PosixOrPid.hs | 14 | ||||
-rw-r--r-- | Annex/Ssh.hs | 4 | ||||
-rw-r--r-- | Annex/Transfer.hs | 14 | ||||
-rw-r--r-- | Logs/Transfer.hs | 39 | ||||
-rw-r--r-- | Remote/Helper/Hooks.hs | 4 | ||||
-rw-r--r-- | Types/LockCache.hs | 2 |
8 files changed, 59 insertions, 46 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs index bc28cc6b4..5990d194a 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -62,7 +62,7 @@ import Annex.Perms import Annex.Link import Annex.Content.Direct import Annex.ReplaceFile -import Utility.LockPool +import Annex.LockPool import Messages.Progress import qualified Types.Remote import qualified Types.Backend @@ -113,12 +113,12 @@ inAnnexSafe key = inAnnex' (fromMaybe True) (Just False) go key =<< contentLockFile key #ifndef mingw32_HOST_OS - checkindirect contentfile = liftIO $ checkOr is_missing contentfile + checkindirect contentfile = checkOr is_missing contentfile {- In direct mode, the content file must exist, but - the lock file generally won't exist unless a removal is in - process. -} - checkdirect contentfile lockfile = liftIO $ - ifM (doesFileExist contentfile) + checkdirect contentfile lockfile = + ifM (liftIO $ doesFileExist contentfile) ( checkOr is_unlocked lockfile , return is_missing ) @@ -186,7 +186,7 @@ lockContentShared key a = lockContentUsing lock key $ do withVerifiedCopy LockedCopy u (return True) a where #ifndef mingw32_HOST_OS - lock contentfile Nothing = liftIO $ tryLockShared Nothing contentfile + lock contentfile Nothing = tryLockShared Nothing contentfile lock _ (Just lockfile) = posixLocker tryLockShared lockfile #else lock = winLocker lockShared @@ -205,7 +205,7 @@ lockContentForRemoval key a = lockContentUsing lock key $ lock contentfile Nothing = bracket_ (thawContent contentfile) (freezeContent contentfile) - (liftIO $ tryLockExclusive Nothing contentfile) + (tryLockExclusive Nothing contentfile) lock _ (Just lockfile) = posixLocker tryLockExclusive lockfile #else lock = winLocker lockExclusive @@ -216,11 +216,11 @@ lockContentForRemoval key a = lockContentUsing lock key $ type ContentLocker = FilePath -> Maybe LockFile -> Annex (Maybe LockHandle) #ifndef mingw32_HOST_OS -posixLocker :: (Maybe FileMode -> LockFile -> IO (Maybe LockHandle)) -> LockFile -> Annex (Maybe LockHandle) +posixLocker :: (Maybe FileMode -> LockFile -> Annex (Maybe LockHandle)) -> LockFile -> Annex (Maybe LockHandle) posixLocker takelock lockfile = do mode <- annexFileMode modifyContent lockfile $ - liftIO $ takelock (Just mode) lockfile + takelock (Just mode) lockfile #else winLocker :: (LockFile -> IO (Maybe LockHandle)) -> ContentLocker diff --git a/Annex/LockFile.hs b/Annex/LockFile.hs index 928b36ec5..40f9c6b2a 100644 --- a/Annex/LockFile.hs +++ b/Annex/LockFile.hs @@ -20,7 +20,7 @@ import Annex import Types.LockCache import qualified Git import Annex.Perms -import Utility.LockPool +import Annex.LockPool import qualified Data.Map as M @@ -33,7 +33,7 @@ lockFileCached file = go =<< fromLockCache file go Nothing = do #ifndef mingw32_HOST_OS mode <- annexFileMode - lockhandle <- liftIO $ noUmask mode $ lockShared (Just mode) file + lockhandle <- noUmask mode $ lockShared (Just mode) file #else lockhandle <- liftIO $ waitToLock $ lockShared file #endif @@ -64,12 +64,12 @@ withExclusiveLock getlockfile a = do lockfile <- fromRepo getlockfile createAnnexDirectory $ takeDirectory lockfile mode <- annexFileMode - bracketIO (lock mode lockfile) dropLock (const a) + bracket (lock mode lockfile) (liftIO . dropLock) (const a) where #ifndef mingw32_HOST_OS lock mode = noUmask mode . lockExclusive (Just mode) #else - lock _mode = waitToLock . lockExclusive + lock _mode = liftIO . waitToLock . lockExclusive #endif {- Tries to take an exclusive lock and run an action. If the lock is @@ -79,12 +79,12 @@ tryExclusiveLock getlockfile a = do lockfile <- fromRepo getlockfile createAnnexDirectory $ takeDirectory lockfile mode <- annexFileMode - bracketIO (lock mode lockfile) unlock go + bracket (lock mode lockfile) (liftIO . unlock) go where #ifndef mingw32_HOST_OS lock mode = noUmask mode . tryLockExclusive (Just mode) #else - lock _mode = lockExclusive + lock _mode = liftIO . lockExclusive #endif unlock = maybe noop dropLock go Nothing = return Nothing diff --git a/Annex/LockPool/PosixOrPid.hs b/Annex/LockPool/PosixOrPid.hs index 71c4f0eee..cc1411800 100644 --- a/Annex/LockPool/PosixOrPid.hs +++ b/Annex/LockPool/PosixOrPid.hs @@ -6,7 +6,19 @@ - Licensed under the GNU GPL version 3 or higher. -} -module Annex.LockPool.PosixOrPid where +module Annex.LockPool.PosixOrPid ( + LockFile, + LockHandle, + lockShared, + lockExclusive, + tryLockShared, + tryLockExclusive, + dropLock, + checkLocked, + LockStatus(..), + getLockStatus, + checkSaneLock, +) where import Common.Annex import qualified Annex diff --git a/Annex/Ssh.hs b/Annex/Ssh.hs index 9d716cdc8..c9325bb7d 100644 --- a/Annex/Ssh.hs +++ b/Annex/Ssh.hs @@ -37,7 +37,7 @@ import Types.CleanupActions import Annex.Index (addGitEnv) #ifndef mingw32_HOST_OS import Annex.Perms -import Utility.LockPool +import Annex.LockPool #endif {- Generates parameters to ssh to a given host (or user@host) on a given @@ -159,7 +159,7 @@ sshCleanup = mapM_ cleanup =<< enumSocketFiles let lockfile = socket2lock socketfile unlockFile lockfile mode <- annexFileMode - v <- liftIO $ noUmask mode $ tryLockExclusive (Just mode) lockfile + v <- noUmask mode $ tryLockExclusive (Just mode) lockfile case v of Nothing -> noop Just lck -> do diff --git a/Annex/Transfer.hs b/Annex/Transfer.hs index e72f737ea..2b0c12c8a 100644 --- a/Annex/Transfer.hs +++ b/Annex/Transfer.hs @@ -23,7 +23,7 @@ import Logs.Transfer as X import Annex.Notification as X import Annex.Perms import Utility.Metered -import Utility.LockPool +import Annex.LockPool import Types.Remote (Verification(..)) import Control.Concurrent @@ -79,7 +79,7 @@ runTransfer' ignorelock t file shouldretry transferobserver transferaction = do info <- liftIO $ startTransferInfo file (meter, tfile, metervar) <- mkProgressUpdater t info mode <- annexFileMode - (lck, inprogress) <- liftIO $ prep tfile mode info + (lck, inprogress) <- prep tfile mode info if inprogress && not ignorelock then do showNote "transfer already in progress, or unable to take transfer lock" @@ -96,21 +96,23 @@ runTransfer' ignorelock t file shouldretry transferobserver transferaction = do r <- tryLockExclusive (Just mode) lck case r of Nothing -> return (Nothing, True) - Just lockhandle -> ifM (checkSaneLock lck lockhandle) + Just lockhandle -> ifM (liftIO $ checkSaneLock lck lockhandle) ( do - void $ tryIO $ writeTransferInfoFile info tfile + void $ liftIO $ tryIO $ + writeTransferInfoFile info tfile return (Just lockhandle, False) , return (Nothing, True) ) #else - prep tfile _mode info = do + prep tfile _mode info = liftIO $ do let lck = transferLockFile tfile v <- catchMaybeIO $ lockExclusive lck case v of Nothing -> return (Nothing, False) Just Nothing -> return (Nothing, True) Just (Just lockhandle) -> do - void $ tryIO $ writeTransferInfoFile info tfile + void $ liftIO $ tryIO $ + writeTransferInfoFile info tfile return (Just lockhandle, False) #endif cleanup _ Nothing = noop diff --git a/Logs/Transfer.hs b/Logs/Transfer.hs index af6d19da6..43d097354 100644 --- a/Logs/Transfer.hs +++ b/Logs/Transfer.hs @@ -17,7 +17,7 @@ import Utility.Metered import Utility.Percentage import Utility.QuickCheck import Utility.PID -import Utility.LockPool +import Annex.LockPool import Logs.TimeStamp import Data.Time.Clock @@ -136,25 +136,24 @@ checkTransfer t = do void $ tryIO $ removeFile tfile void $ tryIO $ removeFile $ transferLockFile tfile #ifndef mingw32_HOST_OS - liftIO $ do - let lck = transferLockFile tfile - v <- getLockStatus lck - case v of - StatusLockedBy pid -> catchDefaultIO Nothing $ - readTransferInfoFile (Just pid) tfile - StatusNoLockFile -> return Nothing - StatusUnLocked -> do - -- Take a non-blocking lock while deleting - -- the stale lock file. Ignore failure - -- due to permissions problems, races, etc. - void $ tryIO $ do - r <- tryLockExclusive Nothing lck - case r of - Just lockhandle -> do - cleanstale - dropLock lockhandle - _ -> noop - return Nothing + let lck = transferLockFile tfile + v <- getLockStatus lck + case v of + StatusLockedBy pid -> liftIO $ catchDefaultIO Nothing $ + readTransferInfoFile (Just pid) tfile + StatusNoLockFile -> return Nothing + StatusUnLocked -> do + -- Take a non-blocking lock while deleting + -- the stale lock file. Ignore failure + -- due to permissions problems, races, etc. + void $ tryIO $ do + r <- tryLockExclusive Nothing lck + case r of + Just lockhandle -> liftIO $ do + cleanstale + dropLock lockhandle + _ -> noop + return Nothing #else v <- liftIO $ lockShared $ transferLockFile tfile liftIO $ case v of diff --git a/Remote/Helper/Hooks.hs b/Remote/Helper/Hooks.hs index 1f46eaa4b..96cca242e 100644 --- a/Remote/Helper/Hooks.hs +++ b/Remote/Helper/Hooks.hs @@ -16,7 +16,7 @@ import Types.Remote import Types.CleanupActions import qualified Annex import Annex.LockFile -import Utility.LockPool +import Annex.LockPool #ifndef mingw32_HOST_OS import Annex.Perms #endif @@ -83,7 +83,7 @@ runHooks r starthook stophook a = do unlockFile lck #ifndef mingw32_HOST_OS mode <- annexFileMode - v <- liftIO $ noUmask mode $ tryLockExclusive (Just mode) lck + v <- noUmask mode $ tryLockExclusive (Just mode) lck #else v <- liftIO $ lockExclusive lck #endif diff --git a/Types/LockCache.hs b/Types/LockCache.hs index c1f394cf0..8e0fd2c38 100644 --- a/Types/LockCache.hs +++ b/Types/LockCache.hs @@ -11,6 +11,6 @@ module Types.LockCache ( ) where import qualified Data.Map as M -import Utility.LockPool +import Utility.LockPool (LockHandle) type LockCache = M.Map FilePath LockHandle |