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
=<< 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
)
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
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
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
import Types.LockCache
import qualified Git
import Annex.Perms
-import Utility.LockPool
+import Annex.LockPool
import qualified Data.Map as M
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
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
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
- 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
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
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
import Annex.Notification as X
import Annex.Perms
import Utility.Metered
-import Utility.LockPool
+import Annex.LockPool
import Types.Remote (Verification(..))
import Control.Concurrent
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"
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
import Utility.Percentage
import Utility.QuickCheck
import Utility.PID
-import Utility.LockPool
+import Annex.LockPool
import Logs.TimeStamp
import Data.Time.Clock
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
import Types.CleanupActions
import qualified Annex
import Annex.LockFile
-import Utility.LockPool
+import Annex.LockPool
#ifndef mingw32_HOST_OS
import Annex.Perms
#endif
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
) where
import qualified Data.Map as M
-import Utility.LockPool
+import Utility.LockPool (LockHandle)
type LockCache = M.Map FilePath LockHandle