convert from Utility.LockPool to Annex.LockPool everywhere

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 $
+	checkdirect contentfile lockfile =
-		ifM (doesFileExist contentfile)
+		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

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

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

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

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

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
-		let lck = transferLockFile tfile
+	v <- getLockStatus lck
-		v <- getLockStatus lck
+	case v of
-		case v of
+		StatusLockedBy pid -> liftIO $ catchDefaultIO Nothing $
-			StatusLockedBy pid -> catchDefaultIO Nothing $
+			readTransferInfoFile (Just pid) tfile
-				readTransferInfoFile (Just pid) tfile
+		StatusNoLockFile -> return Nothing
-			StatusNoLockFile -> return Nothing
+		StatusUnLocked -> do
-			StatusUnLocked -> do
+			-- Take a non-blocking lock while deleting
-				-- Take a non-blocking lock while deleting
+			-- the stale lock file. Ignore failure
-				-- the stale lock file. Ignore failure
+			-- due to permissions problems, races, etc.
-				-- due to permissions problems, races, etc.
+			void $ tryIO $ do
-				void $ tryIO $ do
+				r <- tryLockExclusive Nothing lck
-					r <- tryLockExclusive Nothing lck
+				case r of
-					case r of
+					Just lockhandle -> liftIO $ do
-						Just lockhandle -> do
+						cleanstale
-							cleanstale
+						dropLock lockhandle
-							dropLock lockhandle
+					_ -> noop
-						_ -> noop
+			return Nothing
-				return Nothing
 #else
 	v <- liftIO $ lockShared $ transferLockFile tfile
 	liftIO $ case v of

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

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