added checkPresentExportWithContentIdentifier

Ugh, don't like needing to add this, but I can't see a way around it.

Remote/Directory.hs

@@ -82,6 +82,7 @@ gen r u c gc = do
 				, storeExportWithContentIdentifier = storeExportWithContentIdentifierM dir
 				, removeExportWithContentIdentifier = removeExportWithContentIdentifierM dir
 				, removeExportDirectoryWhenEmpty = Nothing
+				, checkPresentExportWithContentIdentifier = checkPresentExportWithContentIdentifierM dir
 				}
 			, whereisKey = Nothing
 			, remoteFsck = Nothing
@@ -237,10 +238,13 @@ checkPresentM d (LegacyChunks _) k = Legacy.checkKey d locations k
 checkPresentM d _ k = checkPresentGeneric d (locations d k)
 
 checkPresentGeneric :: FilePath -> [FilePath] -> Annex Bool
-checkPresentGeneric d ps = liftIO $
+checkPresentGeneric d ps = checkPresentGeneric' d $
-	ifM (anyM doesFileExist ps)
+	liftIO $ anyM doesFileExist ps
+
+checkPresentGeneric' :: FilePath -> Annex Bool -> Annex Bool
+checkPresentGeneric' d check = ifM check
 	( return True
-		, ifM (doesDirectoryExist d)
+	, ifM (liftIO $ doesDirectoryExist d)
 		( return False
 		, giveup $ "directory " ++ d ++ " is not accessible"
 		)
@@ -411,6 +415,11 @@ removeExportWithContentIdentifierM dir k loc removeablecids =
 	checkExportContent dir loc removeablecids False $
 		removeExportM dir k loc
 
+checkPresentExportWithContentIdentifierM :: FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> Annex Bool
+checkPresentExportWithContentIdentifierM dir _k loc knowncids =
+	checkPresentGeneric' dir $
+		checkExportContent dir loc knowncids False (return True)
+
 -- Checks if the content at an ExportLocation is in the knowncids,
 -- and only runs the callback that modifies it if it's safe to do so.
 --

Remote/Helper/ExportImport.hs

@@ -61,6 +61,7 @@ instance HasImportUnsupported (ImportActions Annex) where
 		, storeExportWithContentIdentifier = \_ _ _ _ _ -> return Nothing
 		, removeExportWithContentIdentifier = \_ _ _ -> return False
 		, removeExportDirectoryWhenEmpty = Just $ \_ -> return False
+		, checkPresentExportWithContentIdentifier = \_ _ _ -> return False
 		}
 
 exportIsSupported :: RemoteConfig -> RemoteGitConfig -> Annex Bool
@@ -140,6 +141,13 @@ adjustExportImport r = case M.lookup "exporttree" (config r) of
 			liftIO $ concat
 				<$> mapM (ContentIdentifier.getContentIdentifiers db (uuid r')) ks
 
+		let checkpresent k loc = do
+			db <- getciddb ciddbv
+			checkPresentExportWithContentIdentifier
+				(importActions r')
+				k loc
+				=<< getknowncids db loc
+
 		return $ r'
 			{ exportActions = (exportActions r')
 				{ storeExport = \f k loc p -> do
@@ -162,16 +170,15 @@ adjustExportImport r = case M.lookup "exporttree" (config r) of
 				-- (by eg copying and then deleting)
 				-- so don't use it
 				, renameExport = \_ _ _ -> return False
+				, checkPresentExport = checkpresent
 				}
+			, checkPresent = if appendonly r'
+				then checkPresent r'
+				else \k -> anyM (checkpresent k)
+					=<< getexportlocs exportdbv k
 			}
 
-	isexport dbv = do
+	isexport dbv = return $ r
-		-- Get export locations for a key. 
-		let getexportlocs = \k -> do
-			db <- getexportdb dbv
-			liftIO $ Export.getExportTree db k
-
-		return $ r
 		-- Storing a key on an export could be implemented,
 		-- but it would perform unncessary work
 		-- when another repository has already stored the
@@ -190,7 +197,7 @@ adjustExportImport r = case M.lookup "exporttree" (config r) of
 		-- so don't need to use retrieveExport. However,
 		-- fall back to it if retrieveKeyFile fails.
 		, retrieveKeyFile = \k af dest p ->
-				let retrieveexport = retrieveKeyFileFromExport getexportlocs (getexportinconflict dbv) k af dest p
+			let retrieveexport = retrieveKeyFileFromExport dbv k af dest p
 			in if appendonly r
 				then do
 					ret@(ok, _v) <- retrieveKeyFile r k af dest p
@@ -228,7 +235,7 @@ adjustExportImport r = case M.lookup "exporttree" (config r) of
 		, checkPresent = if appendonly r
 			then checkPresent r
 			else \k -> anyM (checkPresentExport (exportActions r) k)
-					=<< getexportlocs k
+				=<< getexportlocs dbv k
 		-- checkPresent from an export is more expensive
 		-- than otherwise, so not cheap. Also, this
 		-- avoids things that look at checkPresentCheap and
@@ -301,13 +308,17 @@ adjustExportImport r = case M.lookup "exporttree" (config r) of
 				liftIO $ atomically $
 					writeTVar exportinconflict True
 		
-	retrieveKeyFileFromExport getexportlocs exportinconflict k _af dest p = unVerified $
+	getexportlocs dbv k = do
+		db <- getexportdb dbv
+		liftIO $ Export.getExportTree db k
+
+	retrieveKeyFileFromExport dbv k _af dest p = unVerified $
 		if maybe False (isJust . verifyKeyContent) (maybeLookupBackendVariety (keyVariety k))
 			then do
-				locs <- getexportlocs k
+				locs <- getexportlocs dbv k
 				case locs of
 					[] -> do
-						ifM (liftIO $ atomically $ readTVar exportinconflict)
+						ifM (liftIO $ atomically $ readTVar $ getexportinconflict dbv)
 							( warning "unknown export location, likely due to the export conflict"
 							, warning "unknown export location"
 							)

Types/Remote.hs

@@ -312,4 +312,12 @@ data ImportActions a = ImportActions
 	--
 	-- If the directory is not empty, it should succeed.
 	, removeExportDirectoryWhenEmpty :: Maybe (ExportDirectory -> a Bool)
+	-- Checks if the specified ContentIdentifier is exported to the
+	-- remote at the specified ExportLocation.
+	-- Throws an exception if the remote cannot be accessed.
+	, checkPresentExportWithContentIdentifier
+		:: Key
+		-> ExportLocation
+		-> [ContentIdentifier]
+		-> a Bool
 	}

doc/design/importing_trees_from_special_remotes.mdwn

@@ -219,6 +219,8 @@ This is an extension to the ExportActions api.
 
 	removeExportDirectoryWhenEmpty :: Maybe (ExportDirectory -> Annex Bool)
 
+	checkPresentExportWithContentIdentifier :: Key -> ExportLocation -> [ContentIdentifier] -> Annex (Maybe Bool)
+
 listContents finds the current set of files that are stored in the remote,
 some of which may have been written by other programs than git-annex,
 along with their content identifiers. It returns a list of those, often in
@@ -273,6 +275,15 @@ removeExportDirectoryWhenEmpty is used instead of removeExportDirectory.
 It should only remove empty directories, and succeeds if there are files
 in the directory.
 
+checkPresentExportWithContentIdentifier is used instead of
+checkPresentExport. It should verify that one of the provided
+ContentIdentifiers matches the current content of the file.
+
+Note that renameExport is never used when the special remote supports
+imports, because it may have an implementation that loses changes
+to imported files. (For example, it may copy the file to the new name,
+and delete the old name.)
+
 ## multiple git-annex repos accessing a special remote
 
 If multiple repos can access the remote at the same time, then there's a

doc/todo/import_tree.mdwn

@@ -10,10 +10,9 @@ this.
 
 ## implementation notes
 
-* startExport uses checkPresentExport, but when there's a modified file,
+* Check conflict behavior for both conflicting edits to existing file,
-  it's not unexported, so it present, so checkPresentExport succeeds,
+  and conflicting new files. Note need to check both sequences
-  and so startExport does the wrong thing. Seems to indicate checkPresentExport
+  import,export and export,import.
-  needs to be replaced too.
 
 * Should the ContentIdentifier db be multiwriter? It would simplify
   the situation with the long-lived lock of it in adjustExportImport