add key to FileInfo

MatchingKey is not the thing to use when matching on actual worktreee
files.

Fix reversion in 8.20201116 that made include= and exclude= in
preferred/required content expressions match a path relative to the current
directory, rather than the path from the top of the repository.

Annex/FileMatcher.hs

@@ -72,7 +72,8 @@ checkMatcher :: FileMatcher Annex -> Maybe Key -> AssociatedFile -> AssumeNotPre
 checkMatcher matcher mkey afile notpresent notconfigured d
 	| isEmpty matcher = notconfigured
 	| otherwise = case (mkey, afile) of
-		(Nothing, AssociatedFile (Just file)) -> go =<< fileMatchInfo file
+		(mkey, AssociatedFile (Just file)) ->
+			go =<< fileMatchInfo file mkey
 		(Just key, _) -> go (MatchingKey key afile)
 		_ -> d
   where
@@ -82,12 +83,13 @@ checkMatcher' :: FileMatcher Annex -> MatchInfo -> AssumeNotPresent -> Annex Boo
 checkMatcher' matcher mi notpresent =
 	matchMrun matcher $ \o -> matchAction o notpresent mi
 
-fileMatchInfo :: RawFilePath -> Annex MatchInfo
-fileMatchInfo file = do
+fileMatchInfo :: RawFilePath -> Maybe Key -> Annex MatchInfo
+fileMatchInfo file mkey = do
 	matchfile <- getTopFilePath <$> inRepo (toTopFilePath file)
 	return $ MatchingFile FileInfo
 		{ matchFile = matchfile
 		, contentFile = Just file
+		, matchKey = mkey
 		}
 
 matchAll :: FileMatcher Annex

Annex/Import.hs

@@ -531,6 +531,7 @@ importKeys remote importtreeconfig importcontent importablecontents = do
 			let mi = MatchingFile FileInfo
 				{ matchFile = f
 				, contentFile = Just tmpfile
+				, matchKey = Nothing
 				}
 			islargefile <- checkMatcher' matcher mi mempty
 			if islargefile

CHANGELOG

@@ -17,6 +17,9 @@ git-annex (8.20201128) UNRELEASED; urgency=medium
   * Avoid autoinit when a repo does not have annex.version or annex.uuid
     set, but has a git-annex objects directory, suggesting it was used
     by git-annex before.
+  * Fix reversion in 8.20201116 that made include= and exclude= in
+    preferred/required content expressions match a path relative to the
+    current directory, rather than the path from the top of the repository.
 
  -- Joey Hess <id@joeyh.name>  Mon, 30 Nov 2020 12:55:49 -0400
 

CmdLine/Batch.hs

@@ -131,7 +131,7 @@ batchFilesMatching fmt a = do
 	matcher <- getMatcher
 	go $ \si f ->
 		let f' = toRawFilePath f
-		in ifM (matcher $ MatchingFile $ FileInfo (Just f') f')
+		in ifM (matcher $ MatchingFile $ FileInfo (Just f') f' Nothing)
 			( a (si, f')
 			, return Nothing
 			)

CmdLine/Seek.hs

@@ -115,6 +115,7 @@ withPathContents a params = do
 	checkmatch matcher (f, relf) = matcher $ MatchingFile $ FileInfo
 		{ contentFile = Just f
 		, matchFile = relf
+		, matchKey = Nothing
 		}
 
 withWords :: ([String] -> CommandSeek) -> CmdParams -> CommandSeek
@@ -287,7 +288,7 @@ seekFiltered prefilter a listfs = do
   where
 	process matcher v@(_si, f) =
 		whenM (prefilter v) $
-			whenM (matcher $ MatchingFile $ FileInfo (Just f) f) $
+			whenM (matcher $ MatchingFile $ FileInfo (Just f) f Nothing) $
 				a v
 
 data MatcherInfo = MatcherInfo
@@ -365,7 +366,7 @@ seekFilteredKeys seeker listfs = do
 		-- checked later, to avoid a slow lookup here.
 		(not ((matcherNeedsKey mi || matcherNeedsLocationLog mi) 
 			&& not (matcherNeedsFileName mi)))
-		(MatchingFile $ FileInfo (Just f) f)
+		(MatchingFile $ FileInfo (Just f) f Nothing)
 		(liftIO $ ofeeder ((si, f), sha))
 
 	keyaction f mi content a = 

Command/Add.hs

@@ -184,7 +184,7 @@ start o si file addunlockedmatcher = do
 perform :: AddOptions -> RawFilePath -> AddUnlockedMatcher -> CommandPerform
 perform o file addunlockedmatcher = withOtherTmp $ \tmpdir -> do
 	lockingfile <- not <$> addUnlocked addunlockedmatcher
-		(MatchingFile (FileInfo (Just file) file))
+		(MatchingFile (FileInfo (Just file) file Nothing))
 	let cfg = LockDownConfig
 		{ lockingFile = lockingfile
 		, hardlinkFileTmpDir = Just tmpdir

Command/Import.hs

@@ -241,6 +241,7 @@ startLocal o addunlockedmatcher largematcher mode (srcfile, destfile) =
 		let mi = MatchingFile $ FileInfo
 			{ contentFile = Just srcfile
 			, matchFile = destfile
+			, matchKey = Nothing
 			}
 		lockingfile <- not <$> addUnlocked addunlockedmatcher mi
 		-- Minimal lock down with no hard linking so nothing

Command/Info.hs

@@ -569,7 +569,7 @@ getDirStatInfo o dir = do
   where
 	initial = (emptyKeyInfo, emptyKeyInfo, emptyNumCopiesStats, M.empty)
 	update matcher fast key file vs@(presentdata, referenceddata, numcopiesstats, repodata) =
-		ifM (matcher $ MatchingFile $ FileInfo (Just file) file)
+		ifM (matcher $ MatchingFile $ FileInfo (Just file) file (Just key))
 			( do
 				!presentdata' <- ifM (inAnnex key)
 					( return $ addKey key presentdata

Command/Multicast.hs

@@ -135,7 +135,7 @@ send ups fs = do
 			(fs', cleanup) <- seekHelper id ww LsFiles.inRepo
 				=<< workTreeItems ww fs
 			matcher <- Limit.getMatcher
-			let addlist f o = whenM (matcher $ MatchingFile $ FileInfo (Just f) f) $
+			let addlist f o = whenM (matcher $ MatchingFile $ FileInfo (Just f) f Nothing) $
 				liftIO $ hPutStrLn h o
 			forM_ fs' $ \(_, f) -> do
 				mk <- lookupKey f

Limit.hs

@@ -535,9 +535,11 @@ addAccessedWithin duration = do
 	secs = fromIntegral (durationSeconds duration)
 
 lookupFileKey :: FileInfo -> Annex (Maybe Key)
-lookupFileKey fi = case contentFile fi of
-	Just f -> lookupKey f
-	Nothing -> return Nothing
+lookupFileKey fi = case matchKey fi of
+	Just k -> return (Just k)
+	Nothing -> case contentFile fi of
+		Just f -> lookupKey f
+		Nothing -> return Nothing
 
 checkKey :: (Key -> Annex Bool) -> MatchInfo -> Annex Bool
 checkKey a (MatchingFile fi) = lookupFileKey fi >>= maybe (return False) a

Types/FileMatcher.hs

@@ -18,10 +18,13 @@ import Control.Monad.IO.Class
 import qualified Data.Map as M
 import qualified Data.Set as S
 
--- Information about a file or a key that can be matched on.
+-- Information about a file and/or a key that can be matched on.
 data MatchInfo
 	= MatchingFile FileInfo
 	| MatchingKey Key AssociatedFile
+	-- ^ This is used when operating on a file that may be in another
+	-- branch. The AssociatedFile is the filename, but it should not be
+	-- accessed from disk when matching.
 	| MatchingInfo ProvidedInfo
 	| MatchingUserInfo UserProvidedInfo
 
@@ -33,6 +36,8 @@ data FileInfo = FileInfo
 	-- ^ filepath to match on; may be relative to top of repo or cwd,
 	-- depending on how globs in preferred content expressions
 	-- are intended to be matched
+	, matchKey :: Maybe Key
+	-- ^ provided if a key is already known
 	}
 
 data ProvidedInfo = ProvidedInfo

doc/bugs/drop_claims_that_content_is_required___40__8.20201127__41__.mdwn

@@ -194,3 +194,5 @@ Yes, so far it has worked nicely archiving (and describing via git-annex metadat
 orderly fashion.
 
 [[!meta author=jkniiv]]
+
+> [[fixed|done]] --[[Joey]]

doc/bugs/drop_claims_that_content_is_required___40__8.20201127__41__/comment_1_5d7428158cc90704b96a60eeb55efcd0._comment

@@ -0,0 +1,18 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2020-12-14T19:36:20Z"
+ content="""
+Looks like it was caused by [[!commit d032b0885d80d12c00fa8813e88deab1631eef8a]] which made MatchingKey be used
+rather than MatchingFile. Which oops, mean the filename is left relative rather
+than being made into a path from the top of the repo.
+
+Fixed that and your test case works. I do think this would be a better
+expression for you to use though:
+
+	(include=*.mrimg and exclude=*/arkistoidut/* and exclude=arkistoidut/*)
+
+Or maybe just exclude=arkistoidut/* rather than both, depending on if you
+want to support subdirectories of subdirectories with that name, or only
+the single subdirectory in the top of your repo.
+"""]]