avoid importing deleting submodule

import: When the previously exported tree contained a submodule,
preserve it in the imported tree so it does not get deleted.

The export exclude log, which was used for non-preferred content,
now also includes the submodules. Since the log format is git ls-tree
output, this does not break backwards compatibility.

CHANGELOG

@@ -1,6 +1,8 @@
 git-annex (8.20210311) UNRELEASED; urgency=medium
 
   * export: When a submodule is in the tree to be exported, skip it.
+  * import: When the previously exported tree contained a submodule,
+    preserve it in the imported tree so it does not get deleted.
 
  -- Joey Hess <id@joeyh.name>  Fri, 12 Mar 2021 12:06:37 -0400
 

Command/Export.hs

@@ -87,7 +87,7 @@ seek o = startConcurrency commandStages $ do
 		setConfig (remoteAnnexConfig r "tracking-branch")
 			(fromRef $ exportTreeish o)
 	
-	tree <- filterPreferredContent r =<<
+	tree <- filterExport r =<<
 		fromMaybe (giveup "unknown tree") <$>
 		inRepo (Git.Ref.tree (exportTreeish o))
 	
@@ -121,8 +121,8 @@ getExportCommit r treeish
 
 -- | Changes what's exported to the remote. Does not upload any new
 -- files, but does delete and rename files already exported to the remote.
-changeExport :: Remote -> ExportHandle -> PreferredFiltered Git.Ref -> CommandSeek
+changeExport :: Remote -> ExportHandle -> ExportFiltered Git.Ref -> CommandSeek
-changeExport r db (PreferredFiltered new) = do
+changeExport r db (ExportFiltered new) = do
 	old <- getExport (uuid r)
 	recordExportBeginning (uuid r) new
 	
@@ -236,14 +236,13 @@ newtype AllFilled = AllFilled { fromAllFilled :: Bool }
 --
 -- Once all exported files have reached the remote, updates the
 -- remote tracking branch.
-fillExport :: Remote -> ExportHandle -> PreferredFiltered Git.Ref -> Maybe (RemoteTrackingBranch, Sha) -> Annex Bool
+fillExport :: Remote -> ExportHandle -> ExportFiltered Git.Ref -> Maybe (RemoteTrackingBranch, Sha) -> Annex Bool
-fillExport r db (PreferredFiltered newtree) mtbcommitsha = do
+fillExport r db (ExportFiltered newtree) mtbcommitsha = do
 	(l, cleanup) <- inRepo $ Git.LsTree.lsTree Git.LsTree.LsTreeRecursive newtree
 	cvar <- liftIO $ newMVar (FileUploaded False)
 	allfilledvar <- liftIO $ newMVar (AllFilled True)
 	commandActions $
-		map (startExport r db cvar allfilledvar)
+		map (startExport r db cvar allfilledvar) l
-			(filter shouldexport l)
 	void $ liftIO $ cleanup
 	waitForAllRunningCommandActions
 
@@ -255,14 +254,6 @@ fillExport r db (PreferredFiltered newtree) mtbcommitsha = do
 					>>= setRemoteTrackingBranch tb
 	
 	liftIO $ fromFileUploaded <$> takeMVar cvar
-  where
-	shouldexport ti = case readObjectType (Git.LsTree.typeobj ti) of
-		Just BlobObject -> True
-		Just CommitObject -> False
-		-- ^ submodule is not exported
-		Just TreeObject -> False
-		-- ^ should never happen, lstree is recursing into subtrees
-		Nothing -> False
 
 startExport :: Remote -> ExportHandle -> MVar FileUploaded -> MVar AllFilled -> Git.LsTree.TreeItem -> CommandStart
 startExport r db cvar allfilledvar ti = do
@@ -473,50 +464,59 @@ removeEmptyDirectories r db loc ks
 
 -- | A value that has been filtered through the remote's preferred content
 -- expression.
-newtype PreferredFiltered t = PreferredFiltered t
+newtype ExportFiltered t = ExportFiltered t
 
--- | Filters the tree to files that are preferred content of the remote.
+-- | Filters the tree to annexed files that are preferred content of the
+-- remote, and also including non-annexed files, but not submodules.
 --
--- A log is written with files that were filtered out, so they can be added
+-- A log is written with tree items that were filtered out, so they can
--- back in when importing from the remote.
+-- be added back in when importing from the remote.
-filterPreferredContent :: Remote -> Git.Ref -> Annex (PreferredFiltered Git.Ref)
+filterExport :: Remote -> Git.Ref -> Annex (ExportFiltered Git.Ref)
-filterPreferredContent r tree = logExportExcluded (uuid r) $ \logwriter -> do
+filterExport r tree = logExportExcluded (uuid r) $ \logwriter -> do
 	m <- preferredContentMap
 	case M.lookup (uuid r) m of
-		Just matcher | not (isEmpty matcher) -> do
+		Just matcher | not (isEmpty matcher) ->
-			PreferredFiltered <$> go matcher logwriter
+			ExportFiltered <$> go (Just matcher) logwriter
-		_ -> return (PreferredFiltered tree)
+		_ -> ExportFiltered <$> go Nothing logwriter
   where
-	go matcher logwriter = do
+	go mmatcher logwriter = do
 		g <- Annex.gitRepo
 		Git.Tree.adjustTree
-			(checkmatcher matcher logwriter)
+			(check mmatcher logwriter)
 			[]
 			(\_old new -> new)
 			[]
 			tree
 			g
 
-	checkmatcher matcher logwriter ti@(Git.Tree.TreeItem topf _ sha) =
+	check mmatcher logwriter ti@(Git.Tree.TreeItem topf mode sha) =
-		catKey sha >>= \case
+		case toTreeItemType mode of
-			Just k -> do
+			-- Don't export submodule entries.
-				let mi = MatchingInfo $ ProvidedInfo
+			Just TreeSubmodule -> excluded
-					{ providedFilePath = Just $
+			_ -> case mmatcher of
-						-- Match filename relative
+				Nothing -> return (Just ti)
-						-- to the top of the tree.
+				Just matcher -> catKey sha >>= \case
-						getTopFilePath topf
+					Just k -> checkmatcher matcher k
-					, providedKey = Just k
+					-- Always export non-annexed files.
-					, providedFileSize = Nothing
+					Nothing -> return (Just ti)
-					, providedMimeType = Nothing
+	  where
-					, providedMimeEncoding = Nothing
+		excluded = do
-					, providedLinkType = Nothing
+			() <- liftIO $ logwriter ti
-					}
+			return Nothing
-				ifM (checkMatcher' matcher mi mempty)
-					( return (Just ti)
-					, do
-						() <- liftIO $ logwriter ti
-						return Nothing
-					)
-			-- Always export non-annexed files.
-			Nothing -> return (Just ti)
 
+		checkmatcher matcher k = do
+			let mi = MatchingInfo $ ProvidedInfo
+				{ providedFilePath = Just $
+					-- Match filename relative
+					-- to the top of the tree.
+					getTopFilePath topf
+				, providedKey = Just k
+				, providedFileSize = Nothing
+				, providedMimeType = Nothing
+				, providedMimeEncoding = Nothing
+				, providedLinkType = Nothing
+				}
+			ifM (checkMatcher' matcher mi mempty)
+				( return (Just ti)
+				, excluded
+				)

Command/Sync.hs

@@ -854,7 +854,7 @@ seekExportContent o rs (currbranch, _) = or <$> forM rs go
 			mtbcommitsha <- Command.Export.getExportCommit r b
 			case (mtree, mtbcommitsha) of
 				(Just tree, Just _) -> do
-					filteredtree <- Command.Export.filterPreferredContent r tree
+					filteredtree <- Command.Export.filterExport r tree
 					Command.Export.changeExport r db filteredtree
 					Command.Export.fillExport r db filteredtree mtbcommitsha
 				_ -> nontracking r db
@@ -862,7 +862,7 @@ seekExportContent o rs (currbranch, _) = or <$> forM rs go
 	nontracking r db = do
 		exported <- getExport (Remote.uuid r)
 		maybe noop (warnnontracking r exported) currbranch
-		fillexport r db (exportedTreeishes exported) Nothing
+		nontrackingfillexport r db (exportedTreeishes exported) Nothing
 	
 	warnnontracking r exported currb = inRepo (Git.Ref.tree currb) >>= \case
 		Just currt | not (any (== currt) (exportedTreeishes exported)) ->
@@ -876,11 +876,14 @@ seekExportContent o rs (currbranch, _) = or <$> forM rs go
 	  where
 		gitconfig = show (remoteAnnexConfig r "tracking-branch")
 
-	fillexport _ _ [] _ = return False
+	nontrackingfillexport _ _ [] _ = return False
-	fillexport r db (tree:[]) mtbcommitsha = do
+	nontrackingfillexport r db (tree:[]) mtbcommitsha = do
-		let filteredtree = Command.Export.PreferredFiltered tree
+		-- The tree was already filtered when it was exported, so
+		-- does not need be be filtered again now, when we're only
+		-- filling in any files that did not get transferred.
+		let filteredtree = Command.Export.ExportFiltered tree
 		Command.Export.fillExport r db filteredtree mtbcommitsha
-	fillexport r _ _ _ = do
+	nontrackingfillexport r _ _ _ = do
 		warnExportImportConflict r
 		return False
 

doc/bugs/Exclude_submodules_from_export_to_WEBDAV.mdwn

@@ -34,4 +34,4 @@ It is the rock that I stand on.
 [[!tag projects/datalad]]
 
 
-
+> [[fixed|done]] --[[Joey]] 

doc/bugs/Exclude_submodules_from_export_to_WEBDAV/comment_3_38d687454c618c3321ad6d9b3c4e7a38._comment

@@ -0,0 +1,7 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 3"""
+ date="2021-03-12T17:28:10Z"
+ content="""
+All right, both export and import are fixed.
+"""]]