convert from Utility.LockPool to Annex.LockPool everywhere

This commit is contained in:
Joey Hess 2015-11-12 18:05:45 -04:00
parent cd22340c99
commit aaf1ef268d
Failed to extract signature
8 changed files with 59 additions and 46 deletions

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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