From 3237ddb564f5d2c07d03184d4f43c9c33c612a6c Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Tue, 19 May 2015 23:35:24 -0400
Subject: fix crash in stale transfer lockfile cleanup code

Need to differentiate between the lockfile not being locked, and it not
existing.
---
 Utility/LockPool/Posix.hs | 10 +++++++---
 Utility/LockPool/STM.hs   |  4 ++--
 2 files changed, 9 insertions(+), 5 deletions(-)

(limited to 'Utility/LockPool')

diff --git a/Utility/LockPool/Posix.hs b/Utility/LockPool/Posix.hs
index e05ab9754..506d7b560 100644
--- a/Utility/LockPool/Posix.hs
+++ b/Utility/LockPool/Posix.hs
@@ -12,11 +12,13 @@ module Utility.LockPool.Posix (
 	tryLockExclusive,
 	checkLocked,
 	getLockStatus,
+	LockStatus(..),
 	dropLock,
 	checkSaneLock,
 ) where
 
 import qualified Utility.LockFile.Posix as F
+import Utility.LockFile.Posix (LockStatus(..))
 import qualified Utility.LockPool.STM as P
 import Utility.LockPool.STM (LockFile, LockMode(..))
 import Utility.LockPool.LockHandle
@@ -46,11 +48,13 @@ tryLockExclusive mode file = tryMakeLockHandle
 -- 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 file = P.getLockStatus P.lockPool file (pure True)
+checkLocked file = P.getLockStatus P.lockPool file
+	(pure (Just True))
 	(F.checkLocked file)
 
-getLockStatus :: LockFile -> IO (Maybe ProcessID)
-getLockStatus file = P.getLockStatus P.lockPool file getProcessID
+getLockStatus :: LockFile -> IO LockStatus
+getLockStatus file = P.getLockStatus P.lockPool file
+	(StatusLockedBy <$> getProcessID)
 	(F.getLockStatus file)
 
 checkSaneLock :: LockFile -> LockHandle -> IO Bool
diff --git a/Utility/LockPool/STM.hs b/Utility/LockPool/STM.hs
index 2ab969b20..7b0d138b9 100644
--- a/Utility/LockPool/STM.hs
+++ b/Utility/LockPool/STM.hs
@@ -81,7 +81,7 @@ tryTakeLock pool file mode =
 -- danger of conflicting with locks created at the same time this is
 -- running. With the lock pool empty, anything that attempts
 -- to take a lock will block, avoiding that race.
-getLockStatus :: LockPool -> LockFile -> IO v -> IO (Maybe v) -> IO (Maybe v)
+getLockStatus :: LockPool -> LockFile -> IO v -> IO v -> IO v
 getLockStatus pool file getdefault checker = do
 	v <- atomically $ do
 		m <- takeTMVar pool
@@ -94,7 +94,7 @@ getLockStatus pool file getdefault checker = do
 				return Nothing
 			else return $ Just $ atomically $ putTMVar pool m
 	case v of
-		Nothing -> Just <$> getdefault
+		Nothing -> getdefault
 		Just restore -> bracket_ (return ()) restore checker
 
 -- Only runs action to close underlying lock file when this is the last
-- 
cgit v1.2.3