make sure that lockContentShared is always paired with an inAnnex check

lockContentShared had a screwy caveat that it didn't verify that the content
was present when locking it, but in the most common case, eg indirect mode,
it failed to lock when the content is not present.

That led to a few callers forgetting to check inAnnex when using it,
but the potential data loss was unlikely to be noticed because it only
affected direct mode I think.

Fix data loss bug when the local repository uses direct mode, and a
locally modified file is dropped from a remote repsitory. The bug
caused the modified file to be counted as a copy of the original file.
(This is not a severe bug because in such a situation, dropping
from the remote and then modifying the file is allowed and has the same
end result.)

And, in content locking over tor, when the remote repository is
in direct mode, it neglected to check that the content was actually
present when locking it. This could cause git annex drop to remove
the only copy of a file when it thought the tor remote had a copy.

So, make lockContentShared do its own inAnnex check. This could perhaps
be optimised for direct mode, to avoid the check then, since locking
the content necessarily verifies it exists there, but I have not bothered
with that.

This commit was sponsored by Jeff Goeke-Smith on Patreon.

Annex/Content.hs

@@ -196,19 +196,19 @@ contentLockFile key = Just <$> calcRepo (gitAnnexContentLock 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.
+ - If locking fails, or the content is not present, 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 -> (VerifiedCopy -> Annex a) -> Annex a
-lockContentShared key a = lockContentUsing lock key $ do
-	u <- getUUID
-	withVerifiedCopy LockedCopy u (return True) a
+lockContentShared key a = lockContentUsing lock key $ ifM (inAnnex key)
+	( do
+		u <- getUUID
+		withVerifiedCopy LockedCopy u (return True) a
+	, giveup $ "failed to lock content: not present"
+	)
   where
 #ifndef mingw32_HOST_OS
 	lock contentfile Nothing = tryLockShared Nothing contentfile

CHANGELOG

@@ -6,6 +6,16 @@ git-annex (6.20180228) UNRELEASED; urgency=medium
   * Improve SHA*E extension extraction code to not treat parts of the
     filename that contain punctuation or other non-alphanumeric characters
     as extensions. Before, such characters were filtered out.
+  * Fix data loss bug when the local repository uses direct mode, and a
+    locally modified file is dropped from a remote repsitory. The bug
+    caused the modified file to be counted as a copy of the original file.
+    (This is not a severe bug because in such a situation, dropping
+    from the remote and then modifying the file is allowed and has the same
+    end result.)
+  * Fix bug in content locking over tor, when the remote repository is
+    in direct mode, it neglected to check that the content was actually
+    present when locking it. This could cause git annex drop to remove
+    the only copy of a file when it thought the tor remote had a copy.
 
  -- Joey Hess <id@joeyh.name>  Wed, 28 Feb 2018 11:53:03 -0400
 

Command/LockContent.hs

@@ -22,9 +22,8 @@ cmd = noCommit $
 seek :: CmdParams -> CommandSeek
 seek = withWords start
 
--- First, lock the content. Then, make sure the content is actually
--- present, and print out "OK". Wait for the caller to send a line before
--- dropping the lock.
+-- First, lock the content, then print out "OK". 
+-- Wait for the caller to send a line before dropping the lock.
 start :: [String] -> CommandStart
 start [ks] = do
 	ok <- lockContentShared k (const locksuccess)
@@ -34,12 +33,9 @@ start [ks] = do
 		else exitFailure
   where
 	k = fromMaybe (giveup "bad key") (file2key ks)
-	locksuccess = ifM (inAnnex k)
-		( liftIO $ do
-			putStrLn contentLockedMarker
-			hFlush stdout
-			_ <- getProtocolLine stdin
-			return True
-		, return False
-		)
+	locksuccess = liftIO $ do
+		putStrLn contentLockedMarker
+		hFlush stdout
+		_ <- getProtocolLine stdin
+		return True
 start _ = giveup "Specify exactly 1 key."

P2P/Protocol.hs

@@ -233,8 +233,8 @@ data LocalF c
 	| TryLockContent Key (Bool -> Proto ()) c
 	-- ^ Try to lock the content of a key,  preventing it
 	-- from being deleted, while running the provided protocol
-	-- action. If unable to lock the content, runs the protocol action
-	-- with False.
+	-- action. If unable to lock the content, or the content is not
+	-- present, runs the protocol action with False.
 	| WaitRefChange (ChangedRefs -> c)
 	-- ^ Waits for one or more git refs to change and returns them.
 	deriving (Functor)

Remote/Git.hs

@@ -391,11 +391,8 @@ lockKey r duc key callback
 			-- and then run the callback in the original
 			-- annex monad, not the remote's.
 			onLocalFast r $ 
-				Annex.Content.lockContentShared key $ \vc ->
-					ifM (Annex.Content.inAnnex key)
-						( liftIO $ inorigrepo $ callback vc
-						, failedlock
-						)
+				Annex.Content.lockContentShared key $
+					liftIO . inorigrepo . callback
 		, failedlock
 		)
 	| Git.repoIsSsh (repo r) = do