final scary locking refactoring (for now)

Note that while before checkTransfer this called getLock with WriteLock,
getLockStatus's use of ReadLock will also notice any exclusive locks.
Since transfer info files are only locked exclusively, never shared,
there is no behavior change.

Also, fixes checkLocked to actually return Just False when the file
exists, but is not locked.

2 files changed, 18 insertions, 15 deletions

diff --git a/Logs/Transfer.hs b/Logs/Transfer.hs
index 7928972b3..16c3ebb68 100644
--- a/Logs/Transfer.hs
+++ b/Logs/Transfer.hs
@@ -129,17 +129,12 @@ checkTransfer :: Transfer -> Annex (Maybe TransferInfo)
 checkTransfer t = do
 	tfile <- fromRepo $ transferFile t
 #ifndef mingw32_HOST_OS
-	mfd <- liftIO $ openExistingLockFile (transferLockFile tfile)
-	case mfd of
-		Nothing -> return Nothing -- failed to open file; not running
-		Just fd -> do
-			locked <- liftIO $
-				getLock fd (WriteLock, AbsoluteSeek, 0, 0)
-			liftIO $ closeFd fd
-			case locked of
-				Nothing -> return Nothing
-				Just (pid, _) -> liftIO $ catchDefaultIO Nothing $
-					readTransferInfoFile (Just pid) tfile
+	liftIO $ do
+		v <- getLockStatus (transferLockFile tfile)
+		case v of
+			Just (pid, _) -> catchDefaultIO Nothing $
+				readTransferInfoFile (Just pid) tfile
+			Nothing -> return Nothing
 #else
 	v <- liftIO $ lockShared $ transferLockFile tfile
 	liftIO $ case v of
diff --git a/Utility/LockFile/Posix.hs b/Utility/LockFile/Posix.hs
index 1e43a2832..6e4444fcf 100644
--- a/Utility/LockFile/Posix.hs
+++ b/Utility/LockFile/Posix.hs
@@ -14,6 +14,7 @@ module Utility.LockFile.Posix (
 	openExistingLockFile,
 	isLocked,
 	checkLocked,
+	getLockStatus,
 	dropLock,
 ) where
 
@@ -23,7 +24,6 @@ import Utility.Applicative
 import System.IO
 import System.Posix
 import Data.Maybe
-import Control.Applicative
 
 type LockFile = FilePath
 
@@ -77,15 +77,23 @@ openLockFile filemode lockfile = do
 isLocked :: LockFile -> IO Bool
 isLocked = fromMaybe False <$$> checkLocked
 
+-- Returns Nothing when the file doesn't exist, for cases where
+-- that is different from it not being locked.
 checkLocked :: LockFile -> IO (Maybe Bool)
-checkLocked lockfile = go =<< catchMaybeIO open
+checkLocked = maybe Nothing (Just . isJust) <$$> getLockStatus'
+
+getLockStatus :: LockFile -> IO (Maybe (ProcessID, FileLock))
+getLockStatus = fromMaybe Nothing <$$> getLockStatus'
+
+getLockStatus' :: LockFile -> IO (Maybe (Maybe (ProcessID, FileLock)))
+getLockStatus' lockfile = go =<< catchMaybeIO open
   where
 	open = openFd lockfile ReadOnly Nothing defaultFileFlags
 	go Nothing = return Nothing
 	go (Just h) = do
-		ret <- isJust <$> getLock h (ReadLock, AbsoluteSeek, 0, 0)
+		ret <- getLock h (ReadLock, AbsoluteSeek, 0, 0)
 		closeFd h
-		return $ Just ret
+		return (Just ret)
 
 dropLock :: LockHandle -> IO ()
 dropLock (LockHandle fd) = closeFd fd