reorganize and refactor lock code

Added a convenience Utility.LockFile that is not a windows/posix
portability shim, but still manages to cut down on the boilerplate around
locking.

This commit was sponsored by Johan Herland.

3 files changed, 12 insertions, 35 deletions

diff --git a/Annex/Content.hs b/Annex/Content.hs
index 2a05c2dac..31a4444af 100644
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -56,10 +56,7 @@ import Annex.Perms
 import Annex.Link
 import Annex.Content.Direct
 import Annex.ReplaceFile
-
-#ifdef mingw32_HOST_OS
-import Utility.WinLock
-#endif
+import Utility.LockFile
 
 {- Checks if a given key's content is currently present. -}
 inAnnex :: Key -> Annex Bool
@@ -177,24 +174,21 @@ lockContent key a = do
 			nukeFile lockfile
 #ifndef mingw32_HOST_OS
 	lock contentfile Nothing = opencontentforlock contentfile >>= dolock
-	lock _ (Just lockfile) = openforlock lockfile >>= dolock . Just
+	lock _ (Just lockfile) = createLockFile Nothing lockfile >>= dolock . Just
 	{- Since content files are stored with the write bit disabled, have
 	 - to fiddle with permissions to open for an exclusive lock. -}
 	opencontentforlock f = catchMaybeIO $ ifM (doesFileExist f)
 		( withModifiedFileMode f
 			(`unionFileModes` ownerWriteMode)
-			(openforlock f)
-		, openforlock f
+			(createLockFie Nothing f)
+		, createLockFile Nothing f
 		)
-	openforlock f = openFd f ReadWrite Nothing defaultFileFlags
 	dolock Nothing = return Nothing
 	dolock (Just fd) = do
 		v <- tryIO $ setLock fd (WriteLock, AbsoluteSeek, 0, 0)
 		case v of
 			Left _ -> alreadylocked
-			Right _ -> do
-				setFdOption fd CloseOnExec True
-				return $ Just fd
+			Right _ -> return $ Just fd
 	unlock mlockfile mfd = do
 		maybe noop cleanuplockfile mlockfile
 		liftIO $ maybe noop closeFd mfd
diff --git a/Annex/LockFile.hs b/Annex/LockFile.hs
index 14aa293ae..75047e005 100644
--- a/Annex/LockFile.hs
+++ b/Annex/LockFile.hs
@@ -19,13 +19,10 @@ import Annex
 import Types.LockPool
 import qualified Git
 import Annex.Perms
+import Utility.LockFile
 
 import qualified Data.Map as M
 
-#ifdef mingw32_HOST_OS
-import Utility.WinLock
-#endif
-
 {- Create a specified lock file, and takes a shared lock, which is retained
  - in the pool. -}
 lockFileShared :: FilePath -> Annex ()
@@ -35,10 +32,7 @@ lockFileShared file = go =<< fromLockPool file
 	go Nothing = do
 #ifndef mingw32_HOST_OS
 		mode <- annexFileMode
-		lockhandle <- liftIO $ noUmask mode $
-			openFd file ReadWrite (Just mode) defaultFileFlags
-		liftIO $ setFdOption lockhandle CloseOnExec True
-		liftIO $ waitToSetLock lockhandle (ReadLock, AbsoluteSeek, 0, 0)
+		lockhandle <- liftIO $ noUmask mode $ lockShared (Just mode) file
 #else
 		lockhandle <- liftIO $ waitToLock $ lockShared file
 #endif
@@ -48,11 +42,7 @@ unlockFile :: FilePath -> Annex ()
 unlockFile file = maybe noop go =<< fromLockPool file
   where
 	go lockhandle = do
-#ifndef mingw32_HOST_OS
-		liftIO $ closeFd lockhandle
-#else
 		liftIO $ dropLock lockhandle
-#endif
 		changeLockPool $ M.delete file
 
 getLockPool :: Annex LockPool
@@ -73,16 +63,10 @@ withExclusiveLock getlockfile a = do
 	lockfile <- fromRepo getlockfile
 	createAnnexDirectory $ takeDirectory lockfile
 	mode <- annexFileMode
-	bracketIO (lock lockfile mode) unlock (const a)
+	bracketIO (lock mode lockfile) dropLock (const a)
   where
 #ifndef mingw32_HOST_OS
-	lock lockfile mode = do
-		l <- noUmask mode $ createFile lockfile mode
-		setFdOption l CloseOnExec True
-		waitToSetLock l (WriteLock, AbsoluteSeek, 0, 0)
-		return l
-	unlock = closeFd
+	lock mode = noUmask mode . lockExclusive (Just mode)
 #else
-	lock lockfile _mode = waitToLock $ lockExclusive lockfile
-	unlock = dropLock
+	lock _mode = waitToLock . lockExclusive
 #endif
diff --git a/Annex/Ssh.hs b/Annex/Ssh.hs
index 4b3ee85e5..2b1b809ff 100644
--- a/Annex/Ssh.hs
+++ b/Annex/Ssh.hs
@@ -35,6 +35,7 @@ import Config.Files
 import Utility.Env
 import Types.CleanupActions
 import Annex.Index (addGitEnv)
+import Utility.LockFile
 #ifndef mingw32_HOST_OS
 import Annex.Perms
 #endif
@@ -151,9 +152,7 @@ sshCleanup = mapM_ cleanup =<< enumSocketFiles
 		let lockfile = socket2lock socketfile
 		unlockFile lockfile
 		mode <- annexFileMode
-		fd <- liftIO $ noUmask mode $
-			openFd lockfile ReadWrite (Just mode) defaultFileFlags
-		liftIO $ setFdOption fd CloseOnExec True
+		fd <- liftIO $ noUmask mode $ createLockFile (Just mode) lockfile
 		v <- liftIO $ tryIO $
 			setLock fd (WriteLock, AbsoluteSeek, 0, 0)
 		case v of