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,14 +238,17 @@ 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
-		( return True
+
-		, ifM (doesDirectoryExist d)
+checkPresentGeneric' :: FilePath -> Annex Bool -> Annex Bool
-			( return False
+checkPresentGeneric' d check = ifM check
-			, giveup $ "directory " ++ d ++ " is not accessible"
+	( return True
-			)
+	, ifM (liftIO $ doesDirectoryExist d)
+		( return False
+		, giveup $ "directory " ++ d ++ " is not accessible"
 		)
+	)
 
 storeExportM :: FilePath -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex Bool
 storeExportM d src _k loc p = liftIO $ catchBoolIO $ do
@@ -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,87 +170,86 @@ 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. 
+		-- Storing a key on an export could be implemented,
-		let getexportlocs = \k -> do
+		-- but it would perform unncessary work
-			db <- getexportdb dbv
+		-- when another repository has already stored the
-			liftIO $ Export.getExportTree db k
+		-- key, and the local repository does not know
-
+		-- about it. To avoid unnecessary costs, don't do it.
-		return $ r
+		{ storeKey = \_ _ _ -> do
-			-- Storing a key on an export could be implemented,
+			warning "remote is configured with exporttree=yes; use `git-annex export` to store content on it"
-			-- but it would perform unncessary work
+			return False
-			-- when another repository has already stored the
+		-- Keys can be retrieved using retrieveExport, 
-			-- key, and the local repository does not know
+		-- but since that retrieves from a path in the
-			-- about it. To avoid unnecessary costs, don't do it.
+		-- remote that another writer could have replaced
-			{ storeKey = \_ _ _ -> do
+		-- with content not of the requested key,
-				warning "remote is configured with exporttree=yes; use `git-annex export` to store content on it"
+		-- the content has to be strongly verified.
-				return False
+		--
-			-- Keys can be retrieved using retrieveExport, 
+		-- appendonly remotes have a key/value store,
-			-- but since that retrieves from a path in the
+		-- so don't need to use retrieveExport. However,
-			-- remote that another writer could have replaced
+		-- fall back to it if retrieveKeyFile fails.
-			-- with content not of the requested key,
+		, retrieveKeyFile = \k af dest p ->
-			-- the content has to be strongly verified.
+			let retrieveexport = retrieveKeyFileFromExport dbv k af dest p
-			--
+			in if appendonly r
-			-- appendonly remotes have a key/value store,
+				then do
-			-- so don't need to use retrieveExport. However,
+					ret@(ok, _v) <- retrieveKeyFile r k af dest p
-			-- fall back to it if retrieveKeyFile fails.
+					if ok
-			, retrieveKeyFile = \k af dest p ->
+						then return ret
-				let retrieveexport = retrieveKeyFileFromExport getexportlocs (getexportinconflict dbv) k af dest p
+						else retrieveexport
-				in if appendonly r
+				else retrieveexport
-					then do
+		, retrieveKeyFileCheap = if appendonly r
-						ret@(ok, _v) <- retrieveKeyFile r k af dest p
+			then retrieveKeyFileCheap r
-						if ok
+			else \_ _ _ -> return False
-							then return ret
+		-- Removing a key from an export would need to
-							else retrieveexport
+		-- change the tree in the export log to not include
-					else retrieveexport
+		-- the file. Otherwise, conflicts when removing
-			, retrieveKeyFileCheap = if appendonly r
+		-- files would not be dealt with correctly.
-				then retrieveKeyFileCheap r
+		-- There does not seem to be a good use case for
-				else \_ _ _ -> return False
+		-- removing a key from an export in any case.
-			-- Removing a key from an export would need to
+		, removeKey = \_k -> do
-			-- change the tree in the export log to not include
+			warning "dropping content from an export is not supported; use `git annex export` to export a tree that lacks the files you want to remove"
-			-- the file. Otherwise, conflicts when removing
+			return False
-			-- files would not be dealt with correctly.
+		-- Can't lock content on exports, since they're
-			-- There does not seem to be a good use case for
+		-- not key/value stores, and someone else could
-			-- removing a key from an export in any case.
+		-- change what's exported to a file at any time.
-			, removeKey = \_k -> do
+		--
-				warning "dropping content from an export is not supported; use `git annex export` to export a tree that lacks the files you want to remove"
+		-- (except for appendonly remotes)
-				return False
+		, lockContent = if appendonly r
-			-- Can't lock content on exports, since they're
+			then lockContent r
-			-- not key/value stores, and someone else could
+			else Nothing
-			-- change what's exported to a file at any time.
+		-- Check if any of the files a key was exported to
-			--
+		-- are present. This doesn't guarantee the export
-			-- (except for appendonly remotes)
+		-- contains the right content, which is why export
-			, lockContent = if appendonly r
+		-- remotes are untrusted.
-				then lockContent r
+		--
-				else Nothing
+		-- (but appendonly remotes work the same as any
-			-- Check if any of the files a key was exported to
+		-- non-export remote)
-			-- are present. This doesn't guarantee the export
+		, checkPresent = if appendonly r
-			-- contains the right content, which is why export
+			then checkPresent r
-			-- remotes are untrusted.
+			else \k -> anyM (checkPresentExport (exportActions r) k)
-			--
+				=<< getexportlocs dbv k
-			-- (but appendonly remotes work the same as any
+		-- checkPresent from an export is more expensive
-			-- non-export remote)
+		-- than otherwise, so not cheap. Also, this
-			, checkPresent = if appendonly r
+		-- avoids things that look at checkPresentCheap and
-				then checkPresent r
+		-- silently skip non-present files from behaving
-				else \k -> anyM (checkPresentExport (exportActions r) k)
+		-- in confusing ways when there's an export
-					=<< getexportlocs k
+		-- conflict.
-			-- checkPresent from an export is more expensive
+		, checkPresentCheap = False
-			-- than otherwise, so not cheap. Also, this
+		, mkUnavailable = return Nothing
-			-- avoids things that look at checkPresentCheap and
+		, getInfo = do
-			-- silently skip non-present files from behaving
+			ts <- map fromRef . exportedTreeishes
-			-- in confusing ways when there's an export
+				<$> getExport (uuid r)
-			-- conflict.
+			is <- getInfo r
-			, checkPresentCheap = False
+			return (is++[("export", "yes"), ("exportedtree", unwords ts)])
-			, mkUnavailable = return Nothing
+		}
-			, getInfo = do
-				ts <- map fromRef . exportedTreeishes
-					<$> getExport (uuid r)
-				is <- getInfo r
-				return (is++[("export", "yes"), ("exportedtree", unwords ts)])
-			}
 
 	prepciddb = do
 		lcklckv <- liftIO newEmptyTMVarIO
@@ -300,14 +307,18 @@ adjustExportImport r = case M.lookup "exporttree" (config r) of
 				warnExportConflict r
 				liftIO $ atomically $
 					writeTVar exportinconflict True
+		
+	getexportlocs dbv k = do
+		db <- getexportdb dbv
+		liftIO $ Export.getExportTree db k
 
-	retrieveKeyFileFromExport getexportlocs exportinconflict k _af dest p = unVerified $
+	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