add lockContentShared

Also, rename lockContent to lockContentExclusive

inAnnexSafe should perhaps be eliminated, and instead use
`lockContentShared inAnnex`. However, I'm waiting on that, as there are
only 2 call sites for inAnnexSafe and it's fiddly.

10 files changed, 98 insertions, 48 deletions

diff --git a/Annex/Content.hs b/Annex/Content.hs
index 5032e2691..14dc4d4e5 100644
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -12,7 +12,8 @@ module Annex.Content (
 	inAnnex',
 	inAnnexSafe,
 	inAnnexCheck,
-	lockContent,
+	lockContentShared,
+	lockContentExclusive,
 	getViaTmp,
 	getViaTmp',
 	checkDiskSpaceToGet,
@@ -165,57 +166,104 @@ contentLockFile key = ifM isDirect
 contentLockFile key = Just <$> calcRepo (gitAnnexContentLock key)
 #endif
 
-newtype ContentLock = ContentLock Key
+{- Prevents the content from being removed while the action is running.
+ - Uses a shared lock.
+ -
+ - Does not actually check if the content is present. Use inAnnex for that.
+ - However, since the contentLockFile is the content file in indirect mode,
+ - if the content is not present, locking it will fail.
+ -
+ - If locking fails, throws an exception rather than running the action.
+ -
+ - Note that, in direct mode, nothing prevents the user from directly
+ - editing or removing the content, even while it's locked by this.
+ -}
+lockContentShared :: Key -> Annex a -> Annex a
+lockContentShared = lockContentUsing lock
+  where
+#ifndef mingw32_HOST_OS
+	lock contentfile Nothing = liftIO $ tryLockShared Nothing contentfile
+	lock _ (Just lockfile) = posixLocker tryLockShared lockfile
+#else
+	lock = winLocker lockShared
+#endif
+
+newtype ContentLockExclusive = ContentLockExclusive Key
 
-{- Content is exclusively locked while running an action that might remove
- - it. (If the content is not present, no locking is done.)
+{- Exclusively locks content, while performing an action that
+ - might remove it.
+ -
+ - (If the content is not present, no locking is done.)
  -}
-lockContent :: Key -> (ContentLock -> Annex a) -> Annex a
-lockContent key a = do
+lockContentExclusive :: Key -> (ContentLockExclusive -> Annex a) -> Annex a
+lockContentExclusive key a = lockContentUsing lock key $ 
+	a $ ContentLockExclusive key
+  where
+#ifndef mingw32_HOST_OS
+	{- Since content files are stored with the write bit disabled, have
+	 - to fiddle with permissions to open for an exclusive lock. -}
+	lock contentfile Nothing = bracket_
+		(thawContent contentfile)
+		(freezeContent contentfile)
+		(liftIO $ tryLockExclusive Nothing contentfile)
+	lock _ (Just lockfile) = posixLocker tryLockExclusive lockfile
+#else
+	lock = winLocker lockExclusive
+#endif
+
+{- Passed the object content file, and maybe a separate lock file to use,
+ - when the content file itself should not be locked. -}
+type ContentLocker = FilePath -> Maybe LockFile -> Annex (Maybe LockHandle)
+
+#ifndef mingw32_HOST_OS
+posixLocker :: (Maybe FileMode -> LockFile -> IO (Maybe LockHandle)) -> LockFile -> Annex (Maybe LockHandle)
+posixLocker takelock lockfile = do
+	mode <- annexFileMode
+	modifyContent lockfile $
+		liftIO $ takelock (Just mode) lockfile
+	
+#else
+winLocker :: (LockFile -> IO (Maybe LockHandle)) -> ContentLocker
+winLocker takelock _ (Just lockfile) = do
+	modifyContent lockfile $
+		void $ liftIO $ tryIO $
+			writeFile lockfile ""
+	liftIO $ takelock lockfile
+-- never reached; windows always uses a separate lock file
+winLocker _ _ Nothing = return Nothing
+#endif
+
+lockContentUsing :: ContentLocker -> Key -> Annex a -> Annex a
+lockContentUsing locker key a = do
 	contentfile <- calcRepo $ gitAnnexLocation key
 	lockfile <- contentLockFile key
 	bracket
 		(lock contentfile lockfile)
 		(unlock lockfile)
-		(const $ a $ ContentLock key )
+		(const $ a)
   where
 	alreadylocked = error "content is locked"
-	cleanuplockfile lockfile = modifyContent lockfile $
-		void $ liftIO $ tryIO $
-			nukeFile lockfile
-#ifndef mingw32_HOST_OS
-	{- Since content files are stored with the write bit disabled, have
-	 - to fiddle with permissions to open for an exclusive lock. -}
-	lock contentfile Nothing = trylock $ bracket_
-		(thawContent contentfile)
-		(freezeContent contentfile)
+	failedtolock e = error $ "failed to lock content: " ++ show e
+
+	lock contentfile lockfile =
 		(maybe alreadylocked return 
-			=<< liftIO (tryLockExclusive Nothing contentfile))
-	lock _ (Just lockfile) = trylock $ do
-		mode <- annexFileMode
-		maybe alreadylocked return 
-			=<< modifyContent lockfile
-				(liftIO $ tryLockExclusive (Just mode) lockfile)
+			=<< locker contentfile lockfile)
+		`catchIO` failedtolock
+
+#ifndef mingw32_HOST_OS
 	unlock mlockfile lck = do
 		maybe noop cleanuplockfile mlockfile
 		liftIO $ dropLock lck
-	
-	failedtolock e = error $ "failed to lock content: " ++ show e
-	trylock locker = locker `catchIO` failedtolock
 #else
-	lock _ (Just lockfile) = do
-		modifyContent lockfile $
-			void $ liftIO $ tryIO $
-				writeFile lockfile ""
-		maybe alreadylocked (return . Just)
-			=<< liftIO (lockExclusive lockfile)
-	-- never reached; windows always uses a separate lock file
-	lock _ Nothing = return Nothing
 	unlock mlockfile mlockhandle = do
 		liftIO $ maybe noop dropLock mlockhandle
 		maybe noop cleanuplockfile mlockfile
 #endif
 
+	cleanuplockfile lockfile = modifyContent lockfile $
+		void $ liftIO $ tryIO $
+			nukeFile lockfile
+
 {- Runs an action, passing it the temp file to get,
  - and if the action succeeds, verifies the file matches
  - the key and moves the file into the annex as a key's content. -}
@@ -497,8 +545,8 @@ cleanObjectLoc key cleaner = do
  - In direct mode, deletes the associated files or files, and replaces
  - them with symlinks.
  -}
-removeAnnex :: ContentLock -> Annex ()
-removeAnnex (ContentLock key) = withObjectLoc key remove removedirect
+removeAnnex :: ContentLockExclusive -> Annex ()
+removeAnnex (ContentLockExclusive key) = withObjectLoc key remove removedirect
   where
 	remove file = cleanObjectLoc key $ do
 		secureErase file
diff --git a/Assistant/Unused.hs b/Assistant/Unused.hs
index 194739367..c71604679 100644
--- a/Assistant/Unused.hs
+++ b/Assistant/Unused.hs
@@ -77,7 +77,7 @@ expireUnused duration = do
 	forM_ oldkeys $ \k -> do
 		debug ["removing old unused key", key2file k]
 		liftAnnex $ do
-			lockContent k removeAnnex
+			lockContentExclusive k removeAnnex
 			logStatus k InfoMissing
   where
 	boundry = durationToPOSIXTime <$> duration
diff --git a/Command/Drop.hs b/Command/Drop.hs
index b23f81758..6bbdb58fd 100644
--- a/Command/Drop.hs
+++ b/Command/Drop.hs
@@ -88,12 +88,12 @@ startRemote afile numcopies key remote = do
 	showStart' ("drop " ++ Remote.name remote) key afile
 	next $ performRemote key afile numcopies remote
 
--- Note that lockContent is called before checking if the key is present
--- on enough remotes to allow removal. This avoids a scenario where two
+-- Note that lockContentExclusive is called before checking if the key is
+-- present on enough remotes to allow removal. This avoids a scenario where two
 -- or more remotes are trying to remove a key at the same time, and each
 -- see the key is present on the other.
 performLocal :: Key -> AssociatedFile -> NumCopies -> Maybe Remote -> CommandPerform
-performLocal key afile numcopies knownpresentremote = lockContent key $ \contentlock -> do
+performLocal key afile numcopies knownpresentremote = lockContentExclusive key $ \contentlock -> do
 	(remotes, trusteduuids) <- Remote.keyPossibilitiesTrusted key
 	let trusteduuids' = case knownpresentremote of
 		Nothing -> trusteduuids
diff --git a/Command/DropKey.hs b/Command/DropKey.hs
index 5d44f0fcd..cdb19cabb 100644
--- a/Command/DropKey.hs
+++ b/Command/DropKey.hs
@@ -31,7 +31,7 @@ start key = stopUnless (inAnnex key) $ do
 	next $ perform key
 
 perform :: Key -> CommandPerform
-perform key = lockContent key $ \contentlock -> do
+perform key = lockContentExclusive key $ \contentlock -> do
 	removeAnnex contentlock
 	next $ cleanup key
 
diff --git a/Command/Move.hs b/Command/Move.hs
index a83ea04dd..072c00663 100644
--- a/Command/Move.hs
+++ b/Command/Move.hs
@@ -123,7 +123,7 @@ toPerform dest move key afile fastcheck isthere =
 			finish
   where
 	finish
-		| move = lockContent key $ \contentlock -> do
+		| move = lockContentExclusive key $ \contentlock -> do
 			removeAnnex contentlock
 			next $ Command.Drop.cleanupLocal key
 		| otherwise = next $ return True
diff --git a/Command/TestRemote.hs b/Command/TestRemote.hs
index 7ee5f1359..3a44a1bde 100644
--- a/Command/TestRemote.hs
+++ b/Command/TestRemote.hs
@@ -120,7 +120,7 @@ test st r k =
 	, check "storeKey when already present" store
 	, present True
 	, check "retrieveKeyFile" $ do
-		lockContent k removeAnnex
+		lockContentExclusive k removeAnnex
 		get
 	, check "fsck downloaded object" fsck
 	, check "retrieveKeyFile resume from 33%" $ do
@@ -130,20 +130,20 @@ test st r k =
 			sz <- hFileSize h
 			L.hGet h $ fromInteger $ sz `div` 3
 		liftIO $ L.writeFile tmp partial
-		lockContent k removeAnnex
+		lockContentExclusive k removeAnnex
 		get
 	, check "fsck downloaded object" fsck
 	, check "retrieveKeyFile resume from 0" $ do
 		tmp <- prepTmp k
 		liftIO $ writeFile tmp ""
-		lockContent k removeAnnex
+		lockContentExclusive k removeAnnex
 		get
 	, check "fsck downloaded object" fsck
 	, check "retrieveKeyFile resume from end" $ do
 		loc <- Annex.calcRepo (gitAnnexLocation k)
 		tmp <- prepTmp k
 		void $ liftIO $ copyFileExternal CopyAllMetaData loc tmp
-		lockContent k removeAnnex
+		lockContentExclusive k removeAnnex
 		get
 	, check "fsck downloaded object" fsck
 	, check "removeKey when present" remove
@@ -189,7 +189,7 @@ testUnavailable st r k =
 cleanup :: [Remote] -> [Key] -> Bool -> CommandCleanup
 cleanup rs ks ok = do
 	forM_ rs $ \r -> forM_ ks (Remote.removeKey r)
-	forM_ ks $ \k -> lockContent k removeAnnex
+	forM_ ks $ \k -> lockContentExclusive k removeAnnex
 	return ok
 
 chunkSizes :: Int -> Bool -> [Int]
diff --git a/Command/Uninit.hs b/Command/Uninit.hs
index c49cc4ba0..38e062002 100644
--- a/Command/Uninit.hs
+++ b/Command/Uninit.hs
@@ -105,7 +105,7 @@ removeUnannexed = go []
 	go c [] = return c
 	go c (k:ks) = ifM (inAnnexCheck k $ liftIO . enoughlinks)
 		( do
-			lockContent k removeAnnex
+			lockContentExclusive k removeAnnex
 			go c ks
 		, go (k:c) ks
 		)
diff --git a/Remote/Git.hs b/Remote/Git.hs
index f7a0b4a39..8f7e69cbd 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -350,7 +350,7 @@ dropKey r key
 			commitOnCleanup r $ onLocal r $ do
 				ensureInitialized
 				whenM (Annex.Content.inAnnex key) $ do
-					Annex.Content.lockContent key
+					Annex.Content.lockContentExclusive key
 						Annex.Content.removeAnnex
 					logStatus key InfoMissing
 					Annex.Content.saveState True
diff --git a/Utility/LockPool/Posix.hs b/Utility/LockPool/Posix.hs
index 82e0c8e5e..db6b1d3dd 100644
--- a/Utility/LockPool/Posix.hs
+++ b/Utility/LockPool/Posix.hs
@@ -6,6 +6,7 @@
  -}
 
 module Utility.LockPool.Posix (
+	P.LockFile,
 	LockHandle,
 	lockShared,
 	lockExclusive,
diff --git a/Utility/LockPool/Windows.hs b/Utility/LockPool/Windows.hs
index 754650c30..a88525a9b 100644
--- a/Utility/LockPool/Windows.hs
+++ b/Utility/LockPool/Windows.hs
@@ -6,6 +6,7 @@
  -}
 
 module Utility.LockPool.Windows (
+	P.LockFile,
 	LockHandle,
 	lockShared,
 	lockExclusive,