14 files changed, 93 insertions, 50 deletions

diff --git a/Annex/Content.hs b/Annex/Content.hs
index dc714276d..efe12bb5d 100644
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -7,8 +7,8 @@
 
 module Annex.Content (
 	inAnnex,
-	lockExclusive,
-	lockShared,
+	inAnnexSafe,
+	lockContent,
 	calcGitLink,
 	logStatus,
 	getViaTmp,
@@ -36,22 +36,34 @@ import Types.Key
 import Utility.DataUnits
 import Config
 
-{- Checks if a given key is currently present in the gitAnnexLocation. -}
+{- Checks if a given key's content is currently present. -}
 inAnnex :: Key -> Annex Bool
-inAnnex key = do
+inAnnex = inAnnex' doesFileExist
+inAnnex' :: (FilePath -> IO a) -> Key -> Annex a
+inAnnex' a key = do
 	whenM (fromRepo Git.repoIsUrl) $
 		error "inAnnex cannot check remote repo"
-	inRepo $ doesFileExist . gitAnnexLocation key
+	inRepo $ a . gitAnnexLocation key
+
+{- A safer check; the key's content must not only be present, but
+ - is not in the process of being removed. -}
+inAnnexSafe :: Key -> Annex (Maybe Bool)
+inAnnexSafe = inAnnex' $ \f -> do
+	e <- doesFileExist f
+	if e
+		then do
+			locked <- testlock f
+			if locked
+				then return Nothing
+				else return $ Just True
+		else return $ Just False
+	where
+		testlock f = return False -- TODO
 
 {- Content is exclusively locked to indicate that it's in the process of
  - being removed. -}
-lockExclusive :: Key -> Annex a -> Annex a
-lockExclusive key a = a -- TODO
-
-{- Things that rely on content being present can take a shared lock to
- - avoid it vanishing from under them. -}
-lockShared :: Key -> Annex a -> Annex a
-lockShared key a = a -- TODO
+lockContent :: Key -> Annex a -> Annex a
+lockContent key a = a -- TODO
 
 {- Calculates the relative path to use to link a file to a key. -}
 calcGitLink :: FilePath -> Key -> Annex FilePath
diff --git a/Command/Drop.hs b/Command/Drop.hs
index e81bd9d7d..44685ffcd 100644
--- a/Command/Drop.hs
+++ b/Command/Drop.hs
@@ -52,7 +52,7 @@ startRemote file numcopies key remote = do
 	next $ performRemote key numcopies remote
 
 performLocal :: Key -> Maybe Int -> CommandPerform
-performLocal key numcopies = lockExclusive key $ do
+performLocal key numcopies = lockContent key $ do
 	(remotes, trusteduuids) <- Remote.keyPossibilitiesTrusted key
 	untrusteduuids <- trustGet UnTrusted
 	let tocheck = Remote.remotesWithoutUUID remotes (trusteduuids++untrusteduuids)
@@ -64,7 +64,7 @@ performLocal key numcopies = lockExclusive key $ do
 		else stop
 
 performRemote :: Key -> Maybe Int -> Remote.Remote Annex -> CommandPerform
-performRemote key numcopies remote = lockExclusive key $ do
+performRemote key numcopies remote = lockContent key $ do
 	-- Filter the remote it's being dropped from out of the lists of
 	-- places assumed to have the key, and places to check.
 	-- When the local repo has the key, that's one additional copy.
@@ -95,7 +95,7 @@ cleanupRemote key remote ok = do
 	-- better safe than sorry: assume the remote dropped the key
 	-- even if it seemed to fail; the failure could have occurred
 	-- after it really dropped it
-	Remote.remoteHasKey remote key False
+	Remote.logStatus remote key False
 	return ok
 
 {- Checks specified remotes to verify that enough copies of a key exist to
diff --git a/Command/InAnnex.hs b/Command/InAnnex.hs
index 9c169d0d7..c41f9a92c 100644
--- a/Command/InAnnex.hs
+++ b/Command/InAnnex.hs
@@ -19,8 +19,9 @@ seek :: [CommandSeek]
 seek = [withKeys start]
 
 start :: Key -> CommandStart
-start key = do
-	present <- inAnnex key
-	if present
-		then stop
-		else liftIO exitFailure
+start key = inAnnexSafe key >>= dispatch
+	where
+		dispatch (Just True) = stop
+		dispatch (Just False) = exit 1
+		dispatch Nothing = exit 100
+		exit n = liftIO $ exitWith $ ExitFailure n
diff --git a/Command/Move.hs b/Command/Move.hs
index e955de827..f02f32558 100644
--- a/Command/Move.hs
+++ b/Command/Move.hs
@@ -82,7 +82,7 @@ toPerform dest move key = moveLock move key $ do
 		else Remote.hasKey dest key
 	case isthere of
 		Left err -> do
-			showNote $ show err
+			showNote $ err
 			stop
 		Right False -> do
 			showAction $ "to " ++ Remote.name dest
@@ -96,7 +96,7 @@ toPerform dest move key = moveLock move key $ do
 		Right True -> finish
 	where
 		finish = do
-			Remote.remoteHasKey dest key True
+			Remote.logStatus dest key True
 			if move
 				then do
 					whenM (inAnnex key) $ removeAnnex key
@@ -137,5 +137,5 @@ fromPerform src move key = moveLock move key $ do
 {- Locks a key in order for it to be moved.
  - No lock is needed when a key is being copied. -}
 moveLock :: Bool -> Key -> Annex a -> Annex a
-moveLock True key a = lockExclusive key a
+moveLock True key a = lockContent key a
 moveLock False _ a = a
diff --git a/Remote.hs b/Remote.hs
index f820b62a1..7c0362d2a 100644
--- a/Remote.hs
+++ b/Remote.hs
@@ -26,7 +26,7 @@ module Remote (
 	showTriedRemotes,
 	showLocations,
 	forceTrust,
-	remoteHasKey
+	logStatus
 ) where
 
 import qualified Data.Map as M
@@ -230,7 +230,7 @@ forceTrust level remotename = do
  - in the local repo, not on the remote. The process of transferring the
  - key to the remote, or removing the key from it *may* log the change
  - on the remote, but this cannot always be relied on. -}
-remoteHasKey :: Remote Annex -> Key -> Bool -> Annex ()
-remoteHasKey remote key present	= logChange key (uuid remote) status
+logStatus :: Remote Annex -> Key -> Bool -> Annex ()
+logStatus remote key present = logChange key (uuid remote) status
 	where
 		status = if present then InfoPresent else InfoMissing
diff --git a/Remote/Bup.hs b/Remote/Bup.hs
index b8d7cd317..866d4b42d 100644
--- a/Remote/Bup.hs
+++ b/Remote/Bup.hs
@@ -139,17 +139,21 @@ remove _ = do
  - in a bup repository. One way it to check if the git repository has
  - a branch matching the name (as created by bup split -n).
  -}
-checkPresent :: Git.Repo -> Git.Repo -> Key -> Annex (Either IOException Bool)
+checkPresent :: Git.Repo -> Git.Repo -> Key -> Annex (Either String Bool)
 checkPresent r bupr k
 	| Git.repoIsUrl bupr = do
 		showAction $ "checking " ++ Git.repoDescribe r
 		ok <- onBupRemote bupr boolSystem "git" params
 		return $ Right ok
-	| otherwise = liftIO $ try $ boolSystem "git" $ Git.gitCommandLine params bupr
+	| otherwise = dispatch <$> localcheck
 	where
 		params = 
 			[ Params "show-ref --quiet --verify"
 			, Param $ "refs/heads/" ++ show k]
+		localcheck = liftIO $ try $
+			boolSystem "git" $ Git.gitCommandLine params bupr
+		dispatch (Left e) = Left $ show e
+		dispatch (Right v) = Right v
 
 {- Store UUID in the annex.uuid setting of the bup repository. -}
 storeBupUUID :: UUID -> BupRepo -> Annex ()
diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index 8e306e228..6d3a5da7d 100644
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -114,5 +114,9 @@ remove d k = liftIO $ catchBool $ do
 		file = dirKey d k
 		dir = parentDir file
 
-checkPresent :: FilePath -> Key -> Annex (Either IOException Bool)
-checkPresent d k = liftIO $ try $ doesFileExist (dirKey d k)
+checkPresent :: FilePath -> Key -> Annex (Either String Bool)
+checkPresent d k = dispatch <$> check
+	where
+		check = liftIO $ try $ doesFileExist (dirKey d k)
+		dispatch (Left e) = Left $ show e
+		dispatch (Right v) = Right v
diff --git a/Remote/Git.hs b/Remote/Git.hs
index 75f0ac757..b63a8f124 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -125,22 +125,38 @@ tryGitConfigRead r
 				else old : exchange ls new
 
 {- Checks if a given remote has the content for a key inAnnex.
- - If the remote cannot be accessed, returns a Left error.
+ - If the remote cannot be accessed, or if it cannot determine
+ - whether it has the content, returns a Left error message.
  -}
-inAnnex :: Git.Repo -> Key -> Annex (Either IOException Bool)
+inAnnex :: Git.Repo -> Key -> Annex (Either String Bool)
 inAnnex r key
-	| Git.repoIsHttp r = safely checkhttp
+	| Git.repoIsHttp r = checkhttp
 	| Git.repoIsUrl r = checkremote
-	| otherwise = safely checklocal
+	| otherwise = checklocal
 	where
-		checklocal = onLocal r $ Annex.Content.inAnnex key
+		checkhttp = dispatch <$> check
+			where
+				check = safely $ Url.exists $ keyUrl r key
+				dispatch (Left e) = Left $ show e
+				dispatch (Right v) = Right v
 		checkremote = do
 			showAction $ "checking " ++ Git.repoDescribe r
-			inannex <- onRemote r (boolSystem, False) "inannex" 
-				[Param (show key)]
-			return $ Right inannex
-		checkhttp = Url.exists $ keyUrl r key
-		safely a = liftIO (try a ::IO (Either IOException Bool))
+			onRemote r (check, unknown) "inannex" [Param (show key)]
+			where
+				check c p = dispatch <$> safeSystem c p
+				dispatch ExitSuccess = Right True
+				dispatch (ExitFailure 1) = Right False
+				dispatch _ = unknown
+		checklocal = dispatch <$> check
+			where
+				check = safely $ onLocal r $
+					Annex.Content.inAnnexSafe key
+				dispatch (Left e) = Left $ show e
+				dispatch (Right (Just b)) = Right b
+				dispatch (Right Nothing) = unknown
+		safely :: IO a -> Annex (Either IOException a)
+		safely a = liftIO $ try a
+		unknown = Left $ "unable to check " ++ Git.repoDescribe r
 
 {- Runs an action on a local repository inexpensively, by making an annex
  - monad using that repository. -}
diff --git a/Remote/Hook.hs b/Remote/Hook.hs
index 06568a3cb..9f9250e41 100644
--- a/Remote/Hook.hs
+++ b/Remote/Hook.hs
@@ -119,14 +119,16 @@ retrieveEncrypted h (cipher, enck) f = withTmp enck $ \tmp ->
 remove :: String -> Key -> Annex Bool
 remove h k = runHook h "remove" k Nothing $ return True
 
-checkPresent :: Git.Repo -> String -> Key -> Annex (Either IOException Bool)
+checkPresent :: Git.Repo -> String -> Key -> Annex (Either String Bool)
 checkPresent r h k = do
 	showAction $ "checking " ++ Git.repoDescribe r
 	v <- lookupHook h "checkpresent"
-	liftIO (try (check v) ::IO (Either IOException Bool))
+	dispatch <$> liftIO (try (check v) ::IO (Either IOException Bool))
 	where
 		findkey s = show k `elem` lines s
 		env = hookEnv k Nothing
+		dispatch (Left e) = Left $ show e
+		dispatch (Right v) = Right v
 		check Nothing = error "checkpresent hook misconfigured"
 		check (Just hook) = do
 			(frompipe, topipe) <- createPipe
diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs
index 0dfad7293..54834be13 100644
--- a/Remote/Rsync.hs
+++ b/Remote/Rsync.hs
@@ -128,7 +128,7 @@ remove o k = withRsyncScratchDir $ \tmp -> do
 		, Param $ rsyncKeyDir o k
 		]
 
-checkPresent :: Git.Repo -> RsyncOpts -> Key -> Annex (Either IOException Bool)
+checkPresent :: Git.Repo -> RsyncOpts -> Key -> Annex (Either String Bool)
 checkPresent r o k = do
 	showAction $ "checking " ++ Git.repoDescribe r
 	-- note: Does not currently differnetiate between rsync failing
diff --git a/Remote/S3real.hs b/Remote/S3real.hs
index b201b5aad..29117b3a4 100644
--- a/Remote/S3real.hs
+++ b/Remote/S3real.hs
@@ -172,7 +172,7 @@ remove r k = s3Action r False $ \(conn, bucket) -> do
 	res <- liftIO $ deleteObject conn $ bucketKey r bucket k
 	s3Bool res
 
-checkPresent :: Remote Annex -> Key -> Annex (Either IOException Bool)
+checkPresent :: Remote Annex -> Key -> Annex (Either String Bool)
 checkPresent r k = s3Action r noconn $ \(conn, bucket) -> do
 	showAction $ "checking " ++ name r
 	res <- liftIO $ getObjectInfo conn $ bucketKey r bucket k
diff --git a/Remote/Web.hs b/Remote/Web.hs
index da7f38472..64fcd51aa 100644
--- a/Remote/Web.hs
+++ b/Remote/Web.hs
@@ -64,7 +64,7 @@ dropKey _ = do
 	warning "removal from web not supported"
 	return False
 
-checkKey :: Key -> Annex (Either IOException Bool)
+checkKey :: Key -> Annex (Either String Bool)
 checkKey key = do
 	us <- getUrls key
 	if null us
diff --git a/Types/Remote.hs b/Types/Remote.hs
index 0a4a0fa88..ec9b7a7a7 100644
--- a/Types/Remote.hs
+++ b/Types/Remote.hs
@@ -9,7 +9,6 @@
 
 module Types.Remote where
 
-import Control.Exception
 import Data.Map as M
 import Data.Ord
 
@@ -46,8 +45,8 @@ data Remote a = Remote {
 	-- removes a key's contents
 	removeKey :: Key -> a Bool,
 	-- Checks if a key is present in the remote; if the remote
-	-- cannot be accessed returns a Left error.
-	hasKey :: Key -> a (Either IOException Bool),
+	-- cannot be accessed returns a Left error message.
+	hasKey :: Key -> a (Either String Bool),
 	-- Some remotes can check hasKey without an expensive network
 	-- operation.
 	hasKeyCheap :: Bool,
diff --git a/doc/bugs/cyclic_drop.mdwn b/doc/bugs/cyclic_drop.mdwn
index d3264c7ca..7804380ae 100644
--- a/doc/bugs/cyclic_drop.mdwn
+++ b/doc/bugs/cyclic_drop.mdwn
@@ -16,8 +16,8 @@ content and git-annex should refuse to do anything.
 
 Then when checking inannex, try to take a shared lock. Note that to avoid
 deadlock, this must be a nonblocking lock. If it fails, the status of
-the content is unknown, so inannex should fail. Note that this needs to be
-distinguishable from "not in annex".
+the content is unknown, so inannex should fail. Note that this failure 
+needs to be distinguishable from "not in annex".
 
 > Thinking about these lock files, this would be a lot more files, 
 > and would possibly break some assumptions that everything in
@@ -52,6 +52,11 @@ The movee removes its copy.
 So move --to needs to take the content lock on start. Then the inannex
 will fail.
 
+This is why it's important for inannex to fail in a way that is
+distinguishable from "not in annex". Otherwise, move --to
+would see the cycle as the remote not having content, and try to
+redundantly send it, drop it locally, and still race.
+
 -- 
 
 move --from is similar. Consider a case where both the local and the remote