From 00dbe35fbc7261767551ba35193b3af20a6c9c1d Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 28 Sep 2020 11:08:30 -0400 Subject: [PATCH] allow matching on files whose content is not present Anything that needs to examine the file content will fail to match, or fall back to other available information. But the intent is that the matcher be checked for matchNeedsFileContent and only be used if it does not, so the exact behavior doesn't much matter as it should never happen. The real point of this is to not need to provide a dummy content file when matching. This commit was sponsored by Martin D on Patreon. --- Annex/FileMatcher.hs | 2 +- Annex/Import.hs | 2 +- Annex/Ingest.hs | 2 +- CmdLine/Batch.hs | 2 +- CmdLine/Seek.hs | 6 +++--- Command/Add.hs | 2 +- Command/Import.hs | 2 +- Command/Info.hs | 2 +- Command/Multicast.hs | 2 +- Limit.hs | 43 ++++++++++++++++++++++++++----------------- Types/FileMatcher.hs | 5 +++-- 11 files changed, 40 insertions(+), 30 deletions(-) diff --git a/Annex/FileMatcher.hs b/Annex/FileMatcher.hs index a06cdcab24..db58c019b4 100644 --- a/Annex/FileMatcher.hs +++ b/Annex/FileMatcher.hs @@ -85,7 +85,7 @@ fileMatchInfo file = do matchfile <- getTopFilePath <$> inRepo (toTopFilePath file) return $ MatchingFile FileInfo { matchFile = matchfile - , currFile = file + , contentFile = Just file } matchAll :: FileMatcher Annex diff --git a/Annex/Import.hs b/Annex/Import.hs index bc39ca375d..1691c6f3b1 100644 --- a/Annex/Import.hs +++ b/Annex/Import.hs @@ -452,7 +452,7 @@ importKeys remote importtreeconfig importcontent importablecontents = do matcher <- largematcher (fromRawFilePath f) let mi = MatchingFile FileInfo { matchFile = f - , currFile = toRawFilePath tmpfile + , contentFile = Just (toRawFilePath tmpfile) } islargefile <- checkMatcher' matcher mi mempty if islargefile diff --git a/Annex/Ingest.hs b/Annex/Ingest.hs index 16bc7c49b0..d0d14c363c 100644 --- a/Annex/Ingest.hs +++ b/Annex/Ingest.hs @@ -366,7 +366,7 @@ addAnnexedFile ci matcher file key mtmp = ifM (addUnlocked matcher mi) where mi = case mtmp of Just tmp -> MatchingFile $ FileInfo - { currFile = toRawFilePath tmp + { contentFile = Just (toRawFilePath tmp) , matchFile = toRawFilePath file } -- Provide as much info as we can without access to the diff --git a/CmdLine/Batch.hs b/CmdLine/Batch.hs index 62d2e2b87b..4c403e33d2 100644 --- a/CmdLine/Batch.hs +++ b/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 f' f') + in ifM (matcher $ MatchingFile $ FileInfo (Just f') f') ( a (si, f') , return Nothing ) diff --git a/CmdLine/Seek.hs b/CmdLine/Seek.hs index f5c0fe8538..9a5f2d246e 100644 --- a/CmdLine/Seek.hs +++ b/CmdLine/Seek.hs @@ -106,7 +106,7 @@ withPathContents a params = do , return [(p, takeFileName p)] ) checkmatch matcher (f, relf) = matcher $ MatchingFile $ FileInfo - { currFile = toRawFilePath f + { contentFile = Just (toRawFilePath f) , matchFile = toRawFilePath relf } @@ -280,7 +280,7 @@ seekFiltered prefilter a listfs = do where process matcher v@(_si, f) = whenM (prefilter v) $ - whenM (matcher $ MatchingFile $ FileInfo f f) $ + whenM (matcher $ MatchingFile $ FileInfo (Just f) f) $ a v data MatcherInfo = MatcherInfo @@ -358,7 +358,7 @@ seekFilteredKeys seeker listfs = do -- checked later, to avoid a slow lookup here. (not ((matcherNeedsKey mi || matcherNeedsLocationLog mi) && not (matcherNeedsFileName mi))) - (MatchingFile $ FileInfo f f) + (MatchingFile $ FileInfo (Just f) f) (liftIO $ ofeeder ((si, f), sha)) keyaction f mi content a = diff --git a/Command/Add.hs b/Command/Add.hs index e42b71e0eb..b19aaea54a 100644 --- a/Command/Add.hs +++ b/Command/Add.hs @@ -176,7 +176,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 file file)) + (MatchingFile (FileInfo (Just file) file)) let cfg = LockDownConfig { lockingFile = lockingfile , hardlinkFileTmpDir = Just tmpdir diff --git a/Command/Import.hs b/Command/Import.hs index 2de85ef1de..3971a65d34 100644 --- a/Command/Import.hs +++ b/Command/Import.hs @@ -223,7 +223,7 @@ startLocal o addunlockedmatcher largematcher mode (srcfile, destfile) = stop lockdown a = do let mi = MatchingFile $ FileInfo - { currFile = toRawFilePath srcfile + { contentFile = Just (toRawFilePath srcfile) , matchFile = toRawFilePath destfile } lockingfile <- not <$> addUnlocked addunlockedmatcher mi diff --git a/Command/Info.hs b/Command/Info.hs index a2f9f369cb..2e078cd887 100644 --- a/Command/Info.hs +++ b/Command/Info.hs @@ -568,7 +568,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 file file) + ifM (matcher $ MatchingFile $ FileInfo (Just file) file) ( do !presentdata' <- ifM (inAnnex key) ( return $ addKey key presentdata diff --git a/Command/Multicast.hs b/Command/Multicast.hs index 5b0c7f9e93..d90c114649 100644 --- a/Command/Multicast.hs +++ b/Command/Multicast.hs @@ -133,7 +133,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 f f) $ + let addlist f o = whenM (matcher $ MatchingFile $ FileInfo (Just f) f) $ liftIO $ hPutStrLn h o forM_ fs' $ \(_, f) -> do mk <- lookupKey f diff --git a/Limit.hs b/Limit.hs index 414b67be31..0a81c43e8c 100644 --- a/Limit.hs +++ b/Limit.hs @@ -155,9 +155,11 @@ matchMagic _limitname querymagic selectprovidedinfo (Just magic) glob = where cglob = compileGlob glob CaseSensative -- memoized go (MatchingKey _ _) = pure False - go (MatchingFile fi) = catchBoolIO $ - maybe False (matchGlob cglob) - <$> querymagic magic (fromRawFilePath (currFile fi)) + go (MatchingFile fi) = case contentFile fi of + Just f -> catchBoolIO $ + maybe False (matchGlob cglob) + <$> querymagic magic (fromRawFilePath f) + Nothing -> return False go (MatchingInfo p) = matchGlob cglob <$> getInfo (selectprovidedinfo p) matchMagic limitname _ _ Nothing _ = @@ -184,12 +186,14 @@ addLocked = addLimit $ Right $ MatchFiles matchLockStatus :: Bool -> MatchInfo -> Annex Bool matchLockStatus _ (MatchingKey _ _) = pure False matchLockStatus _ (MatchingInfo _) = pure False -matchLockStatus wantlocked (MatchingFile fi) = liftIO $ do - islocked <- isPointerFile (currFile fi) >>= \case - Just _key -> return False - Nothing -> isSymbolicLink - <$> getSymbolicLinkStatus (fromRawFilePath (currFile fi)) - return (islocked == wantlocked) +matchLockStatus wantlocked (MatchingFile fi) = case contentFile fi of + Just f -> liftIO $ do + islocked <- isPointerFile f >>= \case + Just _key -> return False + Nothing -> isSymbolicLink + <$> getSymbolicLinkStatus (fromRawFilePath f) + return (islocked == wantlocked) + Nothing -> return False {- Adds a limit to skip files not believed to be present - in a specfied repository. Optionally on a prior date. -} @@ -436,17 +440,20 @@ limitSize lb vs s = case readSize dataUnits s of } where go sz _ (MatchingFile fi) = case lb of - LimitAnnexFiles -> lookupFileKey fi >>= \case - Just key -> checkkey sz key - Nothing -> return False - LimitDiskFiles -> do - filesize <- liftIO $ catchMaybeIO $ - getFileSize (fromRawFilePath (currFile fi)) - return $ filesize `vs` Just sz + LimitAnnexFiles -> goannexed sz fi + LimitDiskFiles -> case contentFile fi of + Just f -> do + filesize <- liftIO $ catchMaybeIO $ + getFileSize (fromRawFilePath f) + return $ filesize `vs` Just sz + Nothing -> goannexed sz fi go sz _ (MatchingKey key _) = checkkey sz key go sz _ (MatchingInfo p) = getInfo (providedFileSize p) >>= \sz' -> return (Just sz' `vs` Just sz) + goannexed sz fi = lookupFileKey fi >>= \case + Just key -> checkkey sz key + Nothing -> return False checkkey sz key = return $ fromKey keySize key `vs` Just sz addMetaData :: String -> Annex () @@ -506,7 +513,9 @@ addAccessedWithin duration = do secs = fromIntegral (durationSeconds duration) lookupFileKey :: FileInfo -> Annex (Maybe Key) -lookupFileKey = lookupKey . currFile +lookupFileKey fi = 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 diff --git a/Types/FileMatcher.hs b/Types/FileMatcher.hs index 5903d36f7e..8f7f94f323 100644 --- a/Types/FileMatcher.hs +++ b/Types/FileMatcher.hs @@ -25,8 +25,9 @@ data MatchInfo | MatchingInfo ProvidedInfo data FileInfo = FileInfo - { currFile :: RawFilePath - -- ^ current path to the file, for operations that examine it + { contentFile :: Maybe RawFilePath + -- ^ path to a file containing the content, for operations + -- that examine it , matchFile :: RawFilePath -- ^ filepath to match on; may be relative to top of repo or cwd } -- 2.30.2