summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2015-11-12 18:05:45 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2015-11-12 18:13:37 -0400
commit6b074fb7e741020b81d696bd66e62f75fd472966 (patch)
tree284ac39d6ce641c255555e504c89a9f4d9956744
parent549f635c6b64006b5a369795805d08b8f439d54c (diff)
convert from Utility.LockPool to Annex.LockPool everywhere
-rw-r--r--Annex/Content.hs16
-rw-r--r--Annex/LockFile.hs12
-rw-r--r--Annex/LockPool/PosixOrPid.hs14
-rw-r--r--Annex/Ssh.hs4
-rw-r--r--Annex/Transfer.hs14
-rw-r--r--Logs/Transfer.hs39
-rw-r--r--Remote/Helper/Hooks.hs4
-rw-r--r--Types/LockCache.hs2
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