convert from Utility.LockPool to Annex.LockPool everywhere
This commit is contained in:
Joey Hess
parent
cd22340c99
commit
aaf1ef268d
8 changed files with 59 additions and 46 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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,11 +136,10 @@ 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 $
|
||||
StatusLockedBy pid -> liftIO $ catchDefaultIO Nothing $
|
||||
readTransferInfoFile (Just pid) tfile
|
||||
StatusNoLockFile -> return Nothing
|
||||
StatusUnLocked -> do
|
||||
|
|
@ -150,7 +149,7 @@ checkTransfer t = do
|
|||
void $ tryIO $ do
|
||||
r <- tryLockExclusive Nothing lck
|
||||
case r of
|
||||
Just lockhandle -> do
|
||||
Just lockhandle -> liftIO $ do
|
||||
cleanstale
|
||||
dropLock lockhandle
|
||||
_ -> noop
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue