improve messages around export conflicts

When an export conflict prevents accessing a special remote, be clearer
about what the problem is and how to resolve it.

This commit was sponsored by Trenton Cronholm on Patreon.

Annex/Export.hs

@@ -9,10 +9,12 @@ module Annex.Export where
 
 import Annex
 import Annex.CatFile
+import Types
 import Types.Key
-import Types.Remote
 import qualified Git
+import qualified Types.Remote as Remote
 import Config
+import Messages
 
 import qualified Data.Map as M
 import Control.Applicative
@@ -41,5 +43,11 @@ exportKey sha = mk <$> catKey sha
 		, keyChunkNum = Nothing
 		}
 
-exportTree :: RemoteConfig -> Bool
+exportTree :: Remote.RemoteConfig -> Bool
 exportTree c = fromMaybe False $ yesNo =<< M.lookup "exporttree" c
+
+warnExportConflict :: Remote -> Annex ()
+warnExportConflict r = toplevelWarning True $
+	"Export conflict detected. Different trees have been exported to " ++ 
+	Remote.name r ++ 
+	". Use git-annex export to resolve this conflict."

CHANGELOG

@@ -10,6 +10,8 @@ git-annex (7.20181106) UNRELEASED; urgency=medium
     already did.)
   * Fix resume of download of url when the whole file content is
     already actually downloaded.
+  * When an export conflict prevents accessing a special remote,
+    be clearer about what the problem is and how to resolve it.
 
  -- Joey Hess <id@joeyh.name>  Tue, 06 Nov 2018 12:44:27 -0400
 

Command/Sync.hs

@@ -720,9 +720,7 @@ seekExportContent rs (currbranch, _) = or <$> forM rs go
 	fillexport r ea db (Exported { exportedTreeish = t }:[]) =
 		Command.Export.fillExport r ea db t
 	fillexport r _ _ _ = do
-		warning $ "Export conflict detected. Different trees have been exported to " ++ 
-			Remote.name r ++ 
-			". Use git-annex export to resolve this conflict."
+		warnExportConflict r
 		return False
 
 cleanupLocal :: CurrBranch -> CommandStart

Database/Export.hs

@@ -32,6 +32,7 @@ module Database.Export (
 	ExportedDirectoryId,
 	ExportTreeId,
 	ExportTreeCurrentId,
+	ExportUpdateResult(..),
 ) where
 
 import Database.Types
@@ -219,15 +220,20 @@ updateExportTree' h srcek dstek i = do
   where
 	loc = mkExportLocation $ getTopFilePath $ Git.DiffTree.file i
 
-updateExportTreeFromLog :: ExportHandle -> Annex ()
+data ExportUpdateResult = ExportUpdateSuccess | ExportUpdateConflict
+	deriving (Eq)
+
+updateExportTreeFromLog :: ExportHandle -> Annex ExportUpdateResult
 updateExportTreeFromLog db@(ExportHandle _ u) = 
 	withExclusiveLock (gitAnnexExportLock u) $ do
 		old <- liftIO $ fromMaybe emptyTree
 			<$> getExportTreeCurrent db
 		l <- Log.getExport u
 		case map Log.exportedTreeish l of
+			[] -> return ExportUpdateSuccess
 			(new:[]) | new /= old -> do
 				updateExportTree db old new
 				liftIO $ recordExportTreeCurrent db new
 				liftIO $ flushDbQueue db
-			_ -> return ()
+				return ExportUpdateSuccess
+			_ts -> return ExportUpdateConflict

Remote/Helper/Export.hs

@@ -107,6 +107,8 @@ adjustExportable r = case M.lookup "exporttree" (config r) of
 				liftIO $ atomically $
 					writeTVar updateflag (Just False)
 		
+		exportinconflict <- liftIO $ newTVarIO False
+
 		-- Get export locations for a key. Checks once
 		-- if the export log is different than the database and
 		-- updates the database, to notice when an export has been
@@ -114,7 +116,12 @@ adjustExportable r = case M.lookup "exporttree" (config r) of
 		let getexportlocs = \k -> do
 			bracket startupdateonce doneupdateonce $ \updatenow ->
 				when updatenow $
-					updateExportTreeFromLog db
+					updateExportTreeFromLog db >>= \case
+						ExportUpdateSuccess -> return ()
+						ExportUpdateConflict -> do
+							warnExportConflict r
+							liftIO $ atomically $
+								writeTVar exportinconflict True
 			liftIO $ getExportTree db k
 
 		return $ r
@@ -136,7 +143,7 @@ adjustExportable r = case M.lookup "exporttree" (config r) of
 			-- so don't need to use retrieveExport.
 			, retrieveKeyFile = if appendonly r
 				then retrieveKeyFile r
-				else retrieveKeyFileFromExport getexportlocs
+				else retrieveKeyFileFromExport getexportlocs exportinconflict
 			, retrieveKeyFileCheap = if appendonly r
 				then retrieveKeyFileCheap r
 				else \_ _ _ -> return False
@@ -170,18 +177,28 @@ adjustExportable r = case M.lookup "exporttree" (config r) of
 					ea <- exportActions r
 					anyM (checkPresentExport ea k)
 						=<< getexportlocs k
+			-- checkPresent from an export is more expensive
+			-- than otherwise, so not cheap. Also, this
+			-- avoids things that look at checkPresentCheap and
+			-- silently skip non-present files from behaving
+			-- in confusing ways when there's an export
+			-- conflict.
+			, checkPresentCheap = False
 			, mkUnavailable = return Nothing
 			, getInfo = do
 				is <- getInfo r
 				return (is++[("export", "yes")])
 			}
-	retrieveKeyFileFromExport getexportlocs k _af dest p = unVerified $
+	retrieveKeyFileFromExport getexportlocs exportinconflict k _af dest p = unVerified $
 		if maybe False (isJust . verifyKeyContent) (maybeLookupBackendVariety (keyVariety k))
 			then do
 				locs <- getexportlocs k
 				case locs of
 					[] -> do
-						warning "unknown export location"
+						ifM (liftIO $ atomically $ readTVar exportinconflict)
+							( warning "unknown export location, likely due to the export conflict"
+							, warning "unknown export location"
+							)
 						return False
 					(l:_) -> do
 						ea <- exportActions r

doc/bugs/get_from_exporttree_remote_sometimes_fails.mdwn

@@ -24,20 +24,29 @@ Reproducible with git-annex 7.20181106-g58d1b2510 using this script.
 It looks like the export database is not getting updated to reflect the
 export that was made in the other clone of the repository.
 
-	joey@darkstar:/tmp/bench/repoclone>echo .dump | sqlite3 .git/annex/export/163219a6-fdc1-4d3e-98a6-7aed3e9d605d/db/db
-	PRAGMA foreign_keys=OFF;
-	BEGIN TRANSACTION;
-	CREATE TABLE IF NOT EXISTS "exported"("id" INTEGER PRIMARY KEY,"key" VARCHAR NOT NULL,"file" VARCHAR NOT NULL,CONSTRAINT "exported_index" UNIQUE ("key","file"));
-	INSERT INTO exported VALUES(1,'SHA1--257cc5642cb1a054f08cc83f2d943e56fd3ebe99','foo');
-	CREATE TABLE IF NOT EXISTS "exported_directory"("id" INTEGER PRIMARY KEY,"subdir" VARCHAR NOT NULL,"file" VARCHAR NOT NULL,CONSTRAINT "exported_directory_index" UNIQUE ("subdir","file"));
-	CREATE TABLE IF NOT EXISTS "export_tree"("id" INTEGER PRIMARY KEY,"key" VARCHAR NOT NULL,"file" VARCHAR NOT NULL,CONSTRAINT "export_tree_index" UNIQUE ("key","file"));
-	INSERT INTO export_tree VALUES(1,'SHA1--257cc5642cb1a054f08cc83f2d943e56fd3ebe99','foo');
-	CREATE TABLE IF NOT EXISTS "export_tree_current"("id" INTEGER PRIMARY KEY,"tree" VARCHAR NOT NULL,CONSTRAINT "unique_tree" UNIQUE ("tree"));
-	INSERT INTO export_tree_current VALUES(1,'205f6b799e7d5c2524468ca006a0131aa57ecce7');
-	COMMIT;
-
 --[[Joey]]
 
+> Hmm, `git annex sync --content` complains that there was an export
+> conflict, and unexports bar to resolve it. And indeed, there is a 
+> conflict, since export was run in the two different repos without
+> syncing in between.
+> 
+> When there's no conflict, the `git annex get` does succeed.
+> 
+> So the real problem here is that, during an export conflict, there
+> is no indication in `git annex get` about why retrival from the export
+> fails.
+>
+> Also, `git annex get --from dir` / `git annex copy --from dir`
+> silently does nothing.
+
+> Both turn out to only happen with a directory special remote, because it
+> has checkPresentCheap = True. Other special remotes will fail 
+> with "unknown export location", which is not a great error message
+> either but at least hints at the problem.
+>
+> Made it display a better error message. [[done]]
+
 <pre>
 #!/bin/sh
 set -e