From 89b2542d3caae29f64dd95de96d8259b31f489a8 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 28 May 2020 15:55:17 -0400 Subject: [PATCH] annex.skipunknown with transition plan Added annex.skipunknown git config, that can be set to false to change the behavior of commands like `git annex get foo*`, to not skip over files/dirs that are not checked into git and are explicitly listed in the command line. Significant complexity was needed to handle git-annex add, which uses some git ls-files calls, but needs to not use --error-unmatch because of course the files are not known to git. annex.skipunknown is planned to change to default to false in a git-annex release in early 2022. There's a todo for that. --- Annex/AutoMerge.hs | 5 +- Assistant/Threads/SanityChecker.hs | 2 +- Assistant/Threads/TransferScanner.hs | 2 +- Assistant/Threads/Watcher.hs | 4 +- CHANGELOG | 9 +- CmdLine/Seek.hs | 105 +++++++++++------- Command/Add.hs | 11 +- Command/Copy.hs | 6 +- Command/Drop.hs | 5 +- Command/Find.hs | 5 +- Command/Fix.hs | 6 +- Command/Fsck.hs | 6 +- Command/Get.hs | 6 +- Command/Inprogress.hs | 6 +- Command/List.hs | 7 +- Command/Lock.hs | 6 +- Command/Log.hs | 6 +- Command/LookupKey.hs | 2 +- Command/MetaData.hs | 9 +- Command/Migrate.hs | 5 +- Command/Mirror.hs | 5 +- Command/Move.hs | 5 +- Command/Multicast.hs | 4 +- Command/PreCommit.hs | 3 +- Command/Sync.hs | 10 +- Command/Unannex.hs | 5 +- Command/Undo.hs | 2 +- Command/Uninit.hs | 6 +- Command/Unlock.hs | 5 +- Command/Unused.hs | 4 +- Command/View.hs | 2 +- Command/Whereis.hs | 6 +- Git/LsFiles.hs | 96 +++++----------- NEWS | 11 ++ Types/GitConfig.hs | 2 + Upgrade/V1.hs | 2 +- ...re_of_files_added_via_addurls_--batch.mdwn | 9 ++ ..._c479f19eb55dce35364eea30d0b727b7._comment | 3 +- ..._f694e35efa09aa60daf17d63270968af._comment | 17 +++ ...hould_warn_if_file_isn__39__t_in_repo.mdwn | 4 + doc/git-annex.mdwn | 22 ++++ ..._annex.skipunknown_transition_in_2022.mdwn | 4 + 42 files changed, 271 insertions(+), 169 deletions(-) create mode 100644 doc/bugs/annex_metadata___40__not_--batch__39__ed__41___is_not_aware_of_files_added_via_addurls_--batch/comment_3_f694e35efa09aa60daf17d63270968af._comment create mode 100644 doc/todo/complete_annex.skipunknown_transition_in_2022.mdwn diff --git a/Annex/AutoMerge.hs b/Annex/AutoMerge.hs index fe976f88b1..9a96e85fc2 100644 --- a/Annex/AutoMerge.hs +++ b/Annex/AutoMerge.hs @@ -120,7 +120,7 @@ resolveMerge us them inoverlay = do void $ liftIO cleanup unless inoverlay $ do - (deleted, cleanup2) <- inRepo (LsFiles.deleted [top]) + (deleted, cleanup2) <- inRepo (LsFiles.deleted [] [top]) unless (null deleted) $ Annex.Queue.addCommand "rm" [Param "--quiet", Param "-f", Param "--"] @@ -130,7 +130,8 @@ resolveMerge us them inoverlay = do when merged $ do Annex.Queue.flush unless inoverlay $ do - unstagedmap <- inodeMap $ inRepo $ LsFiles.notInRepo False [top] + unstagedmap <- inodeMap $ inRepo $ + LsFiles.notInRepo [] False [top] cleanConflictCruft mergedks' mergedfs' unstagedmap showLongNote "Merge conflict was automatically resolved; you may want to examine the result." return merged diff --git a/Assistant/Threads/SanityChecker.hs b/Assistant/Threads/SanityChecker.hs index 57cf96cefa..2c35d304a0 100644 --- a/Assistant/Threads/SanityChecker.hs +++ b/Assistant/Threads/SanityChecker.hs @@ -152,7 +152,7 @@ dailyCheck urlrenderer = do batchmaker <- liftIO getBatchCommandMaker -- Find old unstaged symlinks, and add them to git. - (unstaged, cleanup) <- liftIO $ Git.LsFiles.notInRepo False ["."] g + (unstaged, cleanup) <- liftIO $ Git.LsFiles.notInRepo [] False ["."] g now <- liftIO getPOSIXTime forM_ unstaged $ \file -> do let file' = fromRawFilePath file diff --git a/Assistant/Threads/TransferScanner.hs b/Assistant/Threads/TransferScanner.hs index 71d7dd0462..ff6404cb86 100644 --- a/Assistant/Threads/TransferScanner.hs +++ b/Assistant/Threads/TransferScanner.hs @@ -128,7 +128,7 @@ expensiveScan urlrenderer rs = batch <~> do <$> filterM inUnwantedGroup us g <- liftAnnex gitRepo - (files, cleanup) <- liftIO $ LsFiles.inRepo [] g + (files, cleanup) <- liftIO $ LsFiles.inRepo [] [] g removablers <- scan unwantedrs files void $ liftIO cleanup diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs index 0956f59ba5..c5b730c696 100644 --- a/Assistant/Threads/Watcher.hs +++ b/Assistant/Threads/Watcher.hs @@ -136,7 +136,7 @@ startupScan scanner = do -- Notice any files that were deleted before -- watching was started. top <- liftAnnex $ fromRepo Git.repoPath - (fs, cleanup) <- liftAnnex $ inRepo $ LsFiles.deleted [top] + (fs, cleanup) <- liftAnnex $ inRepo $ LsFiles.deleted [] [top] forM_ fs $ \f -> do let f' = fromRawFilePath f liftAnnex $ onDel' f' @@ -362,7 +362,7 @@ onDel' file = do onDelDir :: Handler onDelDir dir _ = do debug ["directory deleted", dir] - (fs, clean) <- liftAnnex $ inRepo $ LsFiles.deleted [toRawFilePath dir] + (fs, clean) <- liftAnnex $ inRepo $ LsFiles.deleted [] [toRawFilePath dir] let fs' = map fromRawFilePath fs liftAnnex $ mapM_ onDel' fs' diff --git a/CHANGELOG b/CHANGELOG index 95dd7fe9f8..0c5520c71a 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -1,5 +1,12 @@ git-annex (8.20200523) UNRELEASED; urgency=medium + * Added annex.skipunknown git config, that can be set to false to change + the behavior of commands like `git annex get foo*`, to not skip + over files/dirs that are not checked into git and are explicitly listed in + the command line. + * annex.skipunknown is planned to change to default to false in a + git-annex release in early 2022. If you prefer the current behavior, + you can explicitly set it to true. * Try to enable special remotes configured with autoenable=yes when git-annex auto-initialization happens in a new clone of an existing repo. Previously, git-annex init had to be explicitly run to @@ -14,7 +21,7 @@ git-annex (8.20200523) UNRELEASED; urgency=medium sync -J --content is used with an export remote. * export: Let concurrent transfers be done with -J or annex.jobs. * move --to, copy --to, mirror --to: When concurrency is enabled, run - cleanup actions in separate job pool from uploads. + cleanup actions in separate job pool from uploads. -- Joey Hess Tue, 26 May 2020 10:20:52 -0400 diff --git a/CmdLine/Seek.hs b/CmdLine/Seek.hs index 77c3bd0e2e..7b3ae6c241 100644 --- a/CmdLine/Seek.hs +++ b/CmdLine/Seek.hs @@ -4,7 +4,7 @@ - the values a user passes to a command, and prepare actions operating - on them. - - - Copyright 2010-2018 Joey Hess + - Copyright 2010-2020 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -35,13 +35,13 @@ import Annex.InodeSentinal import qualified Database.Keys import qualified Utility.RawFilePath as R -withFilesInGit :: (RawFilePath -> CommandSeek) -> [WorkTreeItem] -> CommandSeek -withFilesInGit a l = seekActions $ prepFiltered a $ - seekHelper LsFiles.inRepo l +withFilesInGit :: WarnUnmatchWhen -> (RawFilePath -> CommandSeek) -> [WorkTreeItem] -> CommandSeek +withFilesInGit ww a l = seekActions $ prepFiltered a $ + seekHelper ww LsFiles.inRepo l -withFilesInGitNonRecursive :: String -> (RawFilePath -> CommandSeek) -> [WorkTreeItem] -> CommandSeek -withFilesInGitNonRecursive needforce a l = ifM (Annex.getState Annex.force) - ( withFilesInGit a l +withFilesInGitNonRecursive :: WarnUnmatchWhen -> String -> (RawFilePath -> CommandSeek) -> [WorkTreeItem] -> CommandSeek +withFilesInGitNonRecursive ww needforce a l = ifM (Annex.getState Annex.force) + ( withFilesInGit ww a l , if null l then giveup needforce else seekActions $ prepFiltered a (getfiles [] l) @@ -49,7 +49,8 @@ withFilesInGitNonRecursive needforce a l = ifM (Annex.getState Annex.force) where getfiles c [] = return (reverse c) getfiles c ((WorkTreeItem p):ps) = do - (fs, cleanup) <- inRepo $ LsFiles.inRepo [toRawFilePath p] + os <- seekOptions ww + (fs, cleanup) <- inRepo $ LsFiles.inRepo os [toRawFilePath p] case fs of [f] -> do void $ liftIO $ cleanup @@ -66,7 +67,7 @@ withFilesNotInGit a l = go =<< seek force <- Annex.getState Annex.force g <- gitRepo liftIO $ Git.Command.leaveZombie - <$> LsFiles.notInRepo force (map (\(WorkTreeItem f) -> toRawFilePath f) l) g + <$> LsFiles.notInRepo [] force (map (\(WorkTreeItem f) -> toRawFilePath f) l) g go fs = seekActions $ prepFiltered a $ return $ concat $ segmentPaths (map (\(WorkTreeItem f) -> toRawFilePath f) l) fs @@ -104,7 +105,7 @@ withPairs a params = seekActions $ return $ map a $ pairs [] params withFilesToBeCommitted :: (RawFilePath -> CommandSeek) -> [WorkTreeItem] -> CommandSeek withFilesToBeCommitted a l = seekActions $ prepFiltered a $ - seekHelper LsFiles.stagedNotDeleted l + seekHelper WarnUnmatchWorkTreeItems (const LsFiles.stagedNotDeleted) l isOldUnlocked :: RawFilePath -> Annex Bool isOldUnlocked f = liftIO (notSymlink f) <&&> @@ -112,12 +113,12 @@ isOldUnlocked f = liftIO (notSymlink f) <&&> {- unlocked pointer files that are staged, and whose content has not been - modified-} -withUnmodifiedUnlockedPointers :: (RawFilePath -> CommandSeek) -> [WorkTreeItem] -> CommandSeek -withUnmodifiedUnlockedPointers a l = seekActions $ +withUnmodifiedUnlockedPointers :: WarnUnmatchWhen -> (RawFilePath -> CommandSeek) -> [WorkTreeItem] -> CommandSeek +withUnmodifiedUnlockedPointers ww a l = seekActions $ prepFiltered a unlockedfiles where unlockedfiles = filterM isUnmodifiedUnlocked - =<< seekHelper LsFiles.typeChangedStaged l + =<< seekHelper ww (const LsFiles.typeChangedStaged) l isUnmodifiedUnlocked :: RawFilePath -> Annex Bool isUnmodifiedUnlocked f = catKeyFile f >>= \case @@ -125,9 +126,9 @@ isUnmodifiedUnlocked f = catKeyFile f >>= \case Just k -> sameInodeCache f =<< Database.Keys.getInodeCaches k {- Finds files that may be modified. -} -withFilesMaybeModified :: (RawFilePath -> CommandSeek) -> [WorkTreeItem] -> CommandSeek -withFilesMaybeModified a params = seekActions $ - prepFiltered a $ seekHelper LsFiles.modified params +withFilesMaybeModified :: WarnUnmatchWhen -> (RawFilePath -> CommandSeek) -> [WorkTreeItem] -> CommandSeek +withFilesMaybeModified ww a params = seekActions $ + prepFiltered a $ seekHelper ww LsFiles.modified params withKeys :: (Key -> CommandSeek) -> CmdParams -> CommandSeek withKeys a l = seekActions $ return $ map (a . parse) l @@ -228,13 +229,25 @@ prepFiltered a fs = do seekActions :: Annex [CommandSeek] -> Annex () seekActions gen = sequence_ =<< gen -seekHelper :: ([RawFilePath] -> Git.Repo -> IO ([RawFilePath], IO Bool)) -> [WorkTreeItem] -> Annex [RawFilePath] -seekHelper a l = inRepo $ \g -> - concat . concat <$> forM (segmentXargsOrdered l') - (runSegmentPaths (\fs -> Git.Command.leaveZombie <$> a fs g) . map toRawFilePath) +seekHelper :: WarnUnmatchWhen -> ([LsFiles.Options] -> [RawFilePath] -> Git.Repo -> IO ([RawFilePath], IO Bool)) -> [WorkTreeItem] -> Annex [RawFilePath] +seekHelper ww a l = do + os <- seekOptions ww + inRepo $ \g -> + concat . concat <$> forM (segmentXargsOrdered l') + (runSegmentPaths (\fs -> Git.Command.leaveZombie <$> a os fs g) . map toRawFilePath) where l' = map (\(WorkTreeItem f) -> f) l +data WarnUnmatchWhen = WarnUnmatchLsFiles | WarnUnmatchWorkTreeItems + +seekOptions :: WarnUnmatchWhen -> Annex [LsFiles.Options] +seekOptions WarnUnmatchLsFiles = + ifM (annexSkipUnknown <$> Annex.getGitConfig) + ( return [] + , return [LsFiles.ErrorUnmatch] + ) +seekOptions WarnUnmatchWorkTreeItems = return [] + -- An item in the work tree, which may be a file or a directory. newtype WorkTreeItem = WorkTreeItem FilePath @@ -243,30 +256,42 @@ newtype WorkTreeItem = WorkTreeItem FilePath -- seeking for such files. newtype AllowHidden = AllowHidden Bool --- Many git commands like ls-files seek work tree items matching some criteria, --- and silently skip over anything that does not exist. But users expect --- an error message when one of the files they provided as a command-line --- parameter doesn't exist, so this checks that each exists. --- +-- git ls-files without --error-unmatch seeks work tree items matching +-- some criteria, and silently skips over anything that does not exist. + -- Also, when two directories are symlinked, referring to a file --- inside the symlinked directory will be silently skipped by git commands --- like ls-files. But, the user would be surprised for it to be skipped, so --- check if the parent directories are symlinks. -workTreeItems :: CmdParams -> Annex [WorkTreeItem] +-- inside the symlinked directory will be silently skipped by +-- git ls-files without --error-unmatch. +-- +-- Sometimes a command needs to use git-lsfiles that way, perhaps repeatedly. +-- But users expect an error message when one of the files they provided +-- as a command-line parameter doesn't exist, so this checks that each +-- exists when run with WarnUnmatchWorkTreeItems. +-- +-- Note that, unlike --error-unmatch, using this does not warn +-- about command-line parameters that exist, but are not checked into git. +workTreeItems :: WarnUnmatchWhen -> CmdParams -> Annex [WorkTreeItem] workTreeItems = workTreeItems' (AllowHidden False) -workTreeItems' :: AllowHidden -> CmdParams -> Annex [WorkTreeItem] -workTreeItems' (AllowHidden allowhidden) ps = do - currbranch <- getCurrentBranch - forM_ ps $ \p -> do - relf <- liftIO $ relPathCwdToFile p - ifM (not <$> (exists p <||> hidden currbranch relf)) - ( prob (p ++ " not found") - , whenM (viasymlink (upFrom relf)) $ - prob (p ++ " is beyond a symbolic link") - ) - return (map (WorkTreeItem) ps) +workTreeItems' :: AllowHidden -> WarnUnmatchWhen -> CmdParams -> Annex [WorkTreeItem] +workTreeItems' (AllowHidden allowhidden) ww ps = do + case ww of + WarnUnmatchWorkTreeItems -> runcheck + WarnUnmatchLsFiles -> + whenM (annexSkipUnknown <$> Annex.getGitConfig) + runcheck + return (map WorkTreeItem ps) where + runcheck = do + currbranch <- getCurrentBranch + forM_ ps $ \p -> do + relf <- liftIO $ relPathCwdToFile p + ifM (not <$> (exists p <||> hidden currbranch relf)) + ( prob (p ++ " not found") + , whenM (viasymlink (upFrom relf)) $ + prob (p ++ " is beyond a symbolic link") + ) + exists p = isJust <$> liftIO (catchMaybeIO $ getSymbolicLinkStatus p) viasymlink Nothing = return False diff --git a/Command/Add.hs b/Command/Add.hs index 72aae5f3c6..4e33727b25 100644 --- a/Command/Add.hs +++ b/Command/Add.hs @@ -82,10 +82,15 @@ seek o = startConcurrency commandStages $ do giveup "--update --batch is not supported" | otherwise -> batchFilesMatching fmt (gofile . toRawFilePath) NoBatch -> do - l <- workTreeItems (addThese o) - let go a = a (commandAction . gofile) l + -- Avoid git ls-files complaining about files that + -- are not known to git yet, since this will add + -- them. Instead, have workTreeItems warn about other + -- problems, like files that don't exist. + let ww = WarnUnmatchWorkTreeItems + l <- workTreeItems ww (addThese o) + let go a = a ww (commandAction . gofile) l unless (updateOnly o) $ - go withFilesNotInGit + go (const withFilesNotInGit) go withFilesMaybeModified go withUnmodifiedUnlockedPointers diff --git a/Command/Copy.hs b/Command/Copy.hs index ba7c83bf47..13bfc30915 100644 --- a/Command/Copy.hs +++ b/Command/Copy.hs @@ -51,8 +51,10 @@ seek o = startConcurrency commandStages $ do NoBatch -> withKeyOptions (keyOptions o) (autoMode o) (commandAction . Command.Move.startKey (fromToOptions o) Command.Move.RemoveNever) - (withFilesInGit $ commandAction . go) - =<< workTreeItems (copyFiles o) + (withFilesInGit ww $ commandAction . go) + =<< workTreeItems ww (copyFiles o) + where + ww = WarnUnmatchLsFiles {- A copy is just a move that does not delete the source file. - However, auto mode avoids unnecessary copies, and avoids getting or diff --git a/Command/Drop.hs b/Command/Drop.hs index cff5b7df27..ba9ade8c0c 100644 --- a/Command/Drop.hs +++ b/Command/Drop.hs @@ -57,10 +57,11 @@ seek o = startConcurrency commandStages $ Batch fmt -> batchFilesMatching fmt (go . toRawFilePath) NoBatch -> withKeyOptions (keyOptions o) (autoMode o) (commandAction . startKeys o) - (withFilesInGit (commandAction . go)) - =<< workTreeItems (dropFiles o) + (withFilesInGit ww (commandAction . go)) + =<< workTreeItems ww (dropFiles o) where go = whenAnnexed $ start o + ww = WarnUnmatchLsFiles start :: DropOptions -> RawFilePath -> Key -> CommandStart start o file key = start' o key afile ai diff --git a/Command/Find.hs b/Command/Find.hs index eba431c92c..0e2d35c18b 100644 --- a/Command/Find.hs +++ b/Command/Find.hs @@ -57,11 +57,12 @@ seek :: FindOptions -> CommandSeek seek o = case batchOption o of NoBatch -> withKeyOptions (keyOptions o) False (commandAction . startKeys o) - (withFilesInGit (commandAction . go)) - =<< workTreeItems (findThese o) + (withFilesInGit ww (commandAction . go)) + =<< workTreeItems ww (findThese o) Batch fmt -> batchFilesMatching fmt (go . toRawFilePath) where go = whenAnnexed $ start o + ww = WarnUnmatchLsFiles -- only files inAnnex are shown, unless the user has requested -- others via a limit diff --git a/Command/Fix.hs b/Command/Fix.hs index 1a92dc5797..94d40a0eb9 100644 --- a/Command/Fix.hs +++ b/Command/Fix.hs @@ -32,9 +32,11 @@ cmd = noCommit $ withGlobalOptions [annexedMatchingOptions] $ seek :: CmdParams -> CommandSeek seek ps = unlessM crippledFileSystem $ do - withFilesInGit + withFilesInGit ww (commandAction . (whenAnnexed $ start FixAll)) - =<< workTreeItems ps + =<< workTreeItems ww ps + where + ww = WarnUnmatchLsFiles data FixWhat = FixSymlinks | FixAll diff --git a/Command/Fsck.hs b/Command/Fsck.hs index 930162d3bd..7f1a4501bc 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -94,10 +94,12 @@ seek o = startConcurrency commandStages $ do i <- prepIncremental u (incrementalOpt o) withKeyOptions (keyOptions o) False (\kai -> commandAction . startKey from i kai =<< getNumCopies) - (withFilesInGit $ commandAction . (whenAnnexed (start from i))) - =<< workTreeItems (fsckFiles o) + (withFilesInGit ww $ commandAction . (whenAnnexed (start from i))) + =<< workTreeItems ww (fsckFiles o) cleanupIncremental i void $ tryIO $ recordActivity Fsck u + where + ww = WarnUnmatchLsFiles checkDeadRepo :: UUID -> Annex () checkDeadRepo u = diff --git a/Command/Get.hs b/Command/Get.hs index 826174a40c..b4cd4d62e4 100644 --- a/Command/Get.hs +++ b/Command/Get.hs @@ -45,8 +45,10 @@ seek o = startConcurrency downloadStages $ do Batch fmt -> batchFilesMatching fmt (go . toRawFilePath) NoBatch -> withKeyOptions (keyOptions o) (autoMode o) (commandAction . startKeys from) - (withFilesInGit (commandAction . go)) - =<< workTreeItems (getFiles o) + (withFilesInGit ww (commandAction . go)) + =<< workTreeItems ww (getFiles o) + where + ww = WarnUnmatchLsFiles start :: GetOptions -> Maybe Remote -> RawFilePath -> Key -> CommandStart start o from file key = start' expensivecheck from key afile ai diff --git a/Command/Inprogress.hs b/Command/Inprogress.hs index e7d4c505c5..d2fb04a2a5 100644 --- a/Command/Inprogress.hs +++ b/Command/Inprogress.hs @@ -38,9 +38,11 @@ seek o = do | otherwise -> commandAction stop _ -> do let s = S.fromList ts - withFilesInGit + withFilesInGit ww (commandAction . (whenAnnexed (start s))) - =<< workTreeItems (inprogressFiles o) + =<< workTreeItems ww (inprogressFiles o) + where + ww = WarnUnmatchLsFiles start :: S.Set Key -> RawFilePath -> Key -> CommandStart start s _file k diff --git a/Command/List.hs b/Command/List.hs index 7b41a304ec..92e18b654c 100644 --- a/Command/List.hs +++ b/Command/List.hs @@ -44,9 +44,10 @@ seek :: ListOptions -> CommandSeek seek o = do list <- getList o printHeader list - withFilesInGit - (commandAction . (whenAnnexed $ start list)) - =<< workTreeItems (listThese o) + withFilesInGit ww (commandAction . (whenAnnexed $ start list)) + =<< workTreeItems ww (listThese o) + where + ww = WarnUnmatchLsFiles getList :: ListOptions -> Annex [(UUID, RemoteName, TrustLevel)] getList o diff --git a/Command/Lock.hs b/Command/Lock.hs index 626d7cbc2d..a32adb56bf 100644 --- a/Command/Lock.hs +++ b/Command/Lock.hs @@ -30,8 +30,10 @@ cmd = withGlobalOptions [jsonOptions, annexedMatchingOptions] $ seek :: CmdParams -> CommandSeek seek ps = do - l <- workTreeItems ps - withFilesInGit (commandAction . (whenAnnexed startNew)) l + l <- workTreeItems ww ps + withFilesInGit ww (commandAction . (whenAnnexed startNew)) l + where + ww = WarnUnmatchLsFiles startNew :: RawFilePath -> Key -> CommandStart startNew file key = ifM (isJust <$> isAnnexLink file) diff --git a/Command/Log.hs b/Command/Log.hs index b2a7ea7e12..5ca6160671 100644 --- a/Command/Log.hs +++ b/Command/Log.hs @@ -86,11 +86,13 @@ seek o = do zone <- liftIO getCurrentTimeZone let outputter = mkOutputter m zone o case (logFiles o, allOption o) of - (fs, False) -> withFilesInGit + (fs, False) -> withFilesInGit ww (commandAction . (whenAnnexed $ start o outputter)) - =<< workTreeItems fs + =<< workTreeItems ww fs ([], True) -> commandAction (startAll o outputter) (_, True) -> giveup "Cannot specify both files and --all" + where + ww = WarnUnmatchLsFiles start :: LogOptions -> (FilePath -> Outputter) -> RawFilePath -> Key -> CommandStart start o outputter file key = do diff --git a/Command/LookupKey.hs b/Command/LookupKey.hs index 1525046f2d..6f8a4416d4 100644 --- a/Command/LookupKey.hs +++ b/Command/LookupKey.hs @@ -31,7 +31,7 @@ run _ file = seekSingleGitFile file >>= \case -- But, this plumbing command does not recurse through directories. seekSingleGitFile :: FilePath -> Annex (Maybe RawFilePath) seekSingleGitFile file = do - (l, cleanup) <- inRepo (Git.LsFiles.inRepo [toRawFilePath file]) + (l, cleanup) <- inRepo (Git.LsFiles.inRepo [] [toRawFilePath file]) r <- case l of (f:[]) | takeFileName (fromRawFilePath f) == takeFileName file -> return (Just f) diff --git a/Command/MetaData.hs b/Command/MetaData.hs index a47d67494b..038b2f32e9 100644 --- a/Command/MetaData.hs +++ b/Command/MetaData.hs @@ -75,15 +75,16 @@ seek :: MetaDataOptions -> CommandSeek seek o = case batchOption o of NoBatch -> do c <- liftIO currentVectorClock + let ww = WarnUnmatchLsFiles let seeker = case getSet o of - Get _ -> withFilesInGit - GetAll -> withFilesInGit - Set _ -> withFilesInGitNonRecursive + Get _ -> withFilesInGit ww + GetAll -> withFilesInGit ww + Set _ -> withFilesInGitNonRecursive ww "Not recursively setting metadata. Use --force to do that." withKeyOptions (keyOptions o) False (commandAction . startKeys c o) (seeker (commandAction . (whenAnnexed (start c o)))) - =<< workTreeItems (forFiles o) + =<< workTreeItems ww (forFiles o) Batch fmt -> withMessageState $ \s -> case outputType s of JSONOutput _ -> ifM limited ( giveup "combining --batch with file matching options is not currently supported" diff --git a/Command/Migrate.hs b/Command/Migrate.hs index 76e69ae4c2..33b7d4d2c8 100644 --- a/Command/Migrate.hs +++ b/Command/Migrate.hs @@ -26,7 +26,10 @@ cmd = withGlobalOptions [annexedMatchingOptions] $ paramPaths (withParams seek) seek :: CmdParams -> CommandSeek -seek = withFilesInGit (commandAction . (whenAnnexed start)) <=< workTreeItems +seek = withFilesInGit ww (commandAction . (whenAnnexed start)) + <=< workTreeItems ww + where + ww = WarnUnmatchLsFiles start :: RawFilePath -> Key -> CommandStart start file key = do diff --git a/Command/Mirror.hs b/Command/Mirror.hs index a0033971dd..eef184ed81 100644 --- a/Command/Mirror.hs +++ b/Command/Mirror.hs @@ -44,12 +44,13 @@ seek :: MirrorOptions -> CommandSeek seek o = startConcurrency stages $ withKeyOptions (keyOptions o) False (commandAction . startKey o (AssociatedFile Nothing)) - (withFilesInGit (commandAction . (whenAnnexed $ start o))) - =<< workTreeItems (mirrorFiles o) + (withFilesInGit ww (commandAction . (whenAnnexed $ start o))) + =<< workTreeItems ww (mirrorFiles o) where stages = case fromToOptions o of FromRemote _ -> downloadStages ToRemote _ -> commandStages + ww = WarnUnmatchLsFiles start :: MirrorOptions -> RawFilePath -> Key -> CommandStart start o file k = startKey o afile (k, ai) diff --git a/Command/Move.hs b/Command/Move.hs index 78b3b19af1..e754372763 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -60,13 +60,14 @@ seek o = startConcurrency stages $ do Batch fmt -> batchFilesMatching fmt (go . toRawFilePath) NoBatch -> withKeyOptions (keyOptions o) False (commandAction . startKey (fromToOptions o) (removeWhen o)) - (withFilesInGit (commandAction . go)) - =<< workTreeItems (moveFiles o) + (withFilesInGit ww (commandAction . go)) + =<< workTreeItems ww (moveFiles o) where stages = case fromToOptions o of Right (FromRemote _) -> downloadStages Right (ToRemote _) -> commandStages Left ToHere -> downloadStages + ww = WarnUnmatchLsFiles start :: FromToHereOptions -> RemoveWhen -> RawFilePath -> Key -> CommandStart start fromto removewhen f k = start' fromto removewhen afile k ai diff --git a/Command/Multicast.hs b/Command/Multicast.hs index fcb36800d4..9dcded33db 100644 --- a/Command/Multicast.hs +++ b/Command/Multicast.hs @@ -129,7 +129,9 @@ send ups fs = do -- expensive. starting "sending files" (ActionItemOther Nothing) $ withTmpFile "send" $ \t h -> do - fs' <- seekHelper LsFiles.inRepo =<< workTreeItems fs + let ww = WarnUnmatchLsFiles + fs' <- seekHelper ww LsFiles.inRepo + =<< workTreeItems ww fs matcher <- Limit.getMatcher let addlist f o = whenM (matcher $ MatchingFile $ FileInfo f f) $ liftIO $ hPutStrLn h o diff --git a/Command/PreCommit.hs b/Command/PreCommit.hs index 2bd3d6ff4f..17439a0573 100644 --- a/Command/PreCommit.hs +++ b/Command/PreCommit.hs @@ -32,7 +32,8 @@ cmd = command "pre-commit" SectionPlumbing seek :: CmdParams -> CommandSeek seek ps = do - l <- workTreeItems ps + let ww = WarnUnmatchWorkTreeItems + l <- workTreeItems ww ps -- fix symlinks to files being committed flip withFilesToBeCommitted l $ \f -> commandAction $ maybe stop (Command.Fix.start Command.Fix.FixSymlinks f) diff --git a/Command/Sync.hs b/Command/Sync.hs index 352756e723..5bd65b2df3 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -636,11 +636,11 @@ seekSyncContent o rs currbranch = do Just WantAllKeys -> Just <$> genBloomFilter (seekworktree mvar []) _ -> case currbranch of (Just origbranch, Just adj) | adjustmentHidesFiles adj -> do - l <- workTreeItems' (AllowHidden True) (contentOfOption o) + l <- workTreeItems' (AllowHidden True) ww (contentOfOption o) seekincludinghidden origbranch mvar l (const noop) pure Nothing _ -> do - l <- workTreeItems (contentOfOption o) + l <- workTreeItems ww (contentOfOption o) seekworktree mvar l (const noop) pure Nothing withKeyOptions' (keyOptions o) False @@ -651,13 +651,15 @@ seekSyncContent o rs currbranch = do liftIO $ not <$> isEmptyMVar mvar where seekworktree mvar l bloomfeeder = - seekHelper LsFiles.inRepo l + seekHelper ww LsFiles.inRepo l >>= gofiles bloomfeeder mvar seekincludinghidden origbranch mvar l bloomfeeder = - seekHelper (LsFiles.inRepoOrBranch origbranch) l + seekHelper ww (LsFiles.inRepoOrBranch origbranch) l >>= gofiles bloomfeeder mvar + ww = WarnUnmatchLsFiles + gofiles bloomfeeder mvar = mapM_ $ \f -> ifAnnexed f (go (Right bloomfeeder) mvar (AssociatedFile (Just f))) diff --git a/Command/Unannex.hs b/Command/Unannex.hs index d63f9a6b4f..b41a053597 100644 --- a/Command/Unannex.hs +++ b/Command/Unannex.hs @@ -23,7 +23,10 @@ cmd = withGlobalOptions [annexedMatchingOptions] $ paramPaths (withParams seek) seek :: CmdParams -> CommandSeek -seek ps = (withFilesInGit $ commandAction . whenAnnexed start) =<< workTreeItems ps +seek ps = (withFilesInGit ww $ commandAction . whenAnnexed start) + =<< workTreeItems ww ps + where + ww = WarnUnmatchLsFiles start :: RawFilePath -> Key -> CommandStart start file key = stopUnless (inAnnex key) $ diff --git a/Command/Undo.hs b/Command/Undo.hs index d27a4de821..dc9737a15e 100644 --- a/Command/Undo.hs +++ b/Command/Undo.hs @@ -27,7 +27,7 @@ seek :: CmdParams -> CommandSeek seek ps = do -- Safety first; avoid any undo that would touch files that are not -- in the index. - (fs, cleanup) <- inRepo $ LsFiles.notInRepo False (map toRawFilePath ps) + (fs, cleanup) <- inRepo $ LsFiles.notInRepo [] False (map toRawFilePath ps) unless (null fs) $ giveup $ "Cannot undo changes to files that are not checked into git: " ++ unwords (map fromRawFilePath fs) void $ liftIO $ cleanup diff --git a/Command/Uninit.hs b/Command/Uninit.hs index db7d25a7a8..925fbc7086 100644 --- a/Command/Uninit.hs +++ b/Command/Uninit.hs @@ -41,11 +41,13 @@ check = do seek :: CmdParams -> CommandSeek seek ps = do - l <- workTreeItems ps + l <- workTreeItems ww ps withFilesNotInGit (commandAction . whenAnnexed (startCheckIncomplete . fromRawFilePath)) l Annex.changeState $ \s -> s { Annex.fast = True } - withFilesInGit (commandAction . whenAnnexed Command.Unannex.start) l + withFilesInGit ww (commandAction . whenAnnexed Command.Unannex.start) l finish + where + ww = WarnUnmatchLsFiles {- git annex symlinks that are not checked into git could be left by an - interrupted add. -} diff --git a/Command/Unlock.hs b/Command/Unlock.hs index 473dd0c002..a1fa559669 100644 --- a/Command/Unlock.hs +++ b/Command/Unlock.hs @@ -27,7 +27,10 @@ mkcmd n d = withGlobalOptions [jsonOptions, annexedMatchingOptions] $ command n SectionCommon d paramPaths (withParams seek) seek :: CmdParams -> CommandSeek -seek ps = withFilesInGit (commandAction . whenAnnexed start) =<< workTreeItems ps +seek ps = withFilesInGit ww (commandAction . whenAnnexed start) + =<< workTreeItems ww ps + where + ww = WarnUnmatchLsFiles start :: RawFilePath -> Key -> CommandStart start file key = ifM (isJust <$> isAnnexLink file) diff --git a/Command/Unused.hs b/Command/Unused.hs index 4b2de82597..ee777e79d3 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -210,9 +210,9 @@ withKeysReferenced' mdir initial a = do ( return ([], return True) , do top <- fromRepo Git.repoPath - inRepo $ LsFiles.allFiles [top] + inRepo $ LsFiles.allFiles [] [top] ) - Just dir -> inRepo $ LsFiles.inRepo [toRawFilePath dir] + Just dir -> inRepo $ LsFiles.inRepo [] [toRawFilePath dir] go v [] = return v go v (f:fs) = do mk <- lookupFile f diff --git a/Command/View.hs b/Command/View.hs index f4aba27675..9353b45189 100644 --- a/Command/View.hs +++ b/Command/View.hs @@ -101,7 +101,7 @@ checkoutViewBranch view mkbranch = do - removed.) -} top <- liftIO . absPath . fromRawFilePath =<< fromRepo Git.repoPath (l, cleanup) <- inRepo $ - LsFiles.notInRepoIncludingEmptyDirectories False + LsFiles.notInRepoIncludingEmptyDirectories [] False [toRawFilePath top] forM_ l (removeemptydir top) liftIO $ void cleanup diff --git a/Command/Whereis.hs b/Command/Whereis.hs index 0b850ef8ee..fda4825c32 100644 --- a/Command/Whereis.hs +++ b/Command/Whereis.hs @@ -57,8 +57,10 @@ seek o = do NoBatch -> withKeyOptions (keyOptions o) False (commandAction . startKeys o m) - (withFilesInGit (commandAction . go)) - =<< workTreeItems (whereisFiles o) + (withFilesInGit ww (commandAction . go)) + =<< workTreeItems ww (whereisFiles o) + where + ww = WarnUnmatchLsFiles start :: WhereisOptions -> M.Map UUID Remote -> RawFilePath -> Key -> CommandStart start o remotemap file key = diff --git a/Git/LsFiles.hs b/Git/LsFiles.hs index 830b5f5bfe..3b4f610b17 100644 --- a/Git/LsFiles.hs +++ b/Git/LsFiles.hs @@ -1,11 +1,12 @@ {- git ls-files interface - - - Copyright 2010-2019 Joey Hess + - Copyright 2010-2020 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} module Git.LsFiles ( + Options(..), inRepo, inRepoOrBranch, notInRepo, @@ -13,10 +14,8 @@ module Git.LsFiles ( allFiles, deleted, modified, - modifiedOthers, staged, stagedNotDeleted, - stagedOthersDetails, stagedDetails, typeChanged, typeChangedStaged, @@ -63,101 +62,63 @@ guardSafeForLsFiles r a | safeForLsFiles r = a | otherwise = error $ "git ls-files is unsafe to run on repository " ++ repoDescribe r +data Options = ErrorUnmatch + {- Lists files that are checked into git's index at the specified paths. - With no paths, all files are listed. -} -inRepo :: [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool) -inRepo = inRepo' [] +inRepo :: [Options] -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool) +inRepo = inRepo' [Param "--cached"] -inRepo' :: [CommandParam] -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool) -inRepo' ps l repo = guardSafeForLsFiles repo $ pipeNullSplit' params repo +inRepo' :: [CommandParam] -> [Options] -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool) +inRepo' ps os l repo = guardSafeForLsFiles repo $ pipeNullSplit' params repo where params = Param "ls-files" : - Param "--cached" : Param "-z" : - ps ++ + map op os ++ ps ++ (Param "--" : map (File . fromRawFilePath) l) + op ErrorUnmatch = Param "--error-unmatch" {- Files that are checked into the index or have been committed to a - branch. -} -inRepoOrBranch :: Branch -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool) -inRepoOrBranch b = inRepo' [Param $ "--with-tree=" ++ fromRef b] +inRepoOrBranch :: Branch -> [Options] -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool) +inRepoOrBranch b = inRepo' + [ Param "--cached" + , Param ("--with-tree=" ++ fromRef b) + ] {- Scans for files at the specified locations that are not checked into git. -} -notInRepo :: Bool -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool) +notInRepo :: [Options] -> Bool -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool) notInRepo = notInRepo' [] -notInRepo' :: [CommandParam] -> Bool -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool) -notInRepo' ps include_ignored l repo = guardSafeForLsFiles repo $ - pipeNullSplit' params repo +notInRepo' :: [CommandParam] -> [Options] -> Bool -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool) +notInRepo' ps os include_ignored = + inRepo' (Param "--others" : ps ++ exclude) os where - params = concat - [ [ Param "ls-files", Param "--others"] - , ps - , exclude - , [ Param "-z", Param "--" ] - , map (File . fromRawFilePath) l - ] exclude | include_ignored = [] | otherwise = [Param "--exclude-standard"] {- Scans for files at the specified locations that are not checked into - git. Empty directories are included in the result. -} -notInRepoIncludingEmptyDirectories :: Bool -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool) +notInRepoIncludingEmptyDirectories :: [Options] -> Bool -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool) notInRepoIncludingEmptyDirectories = notInRepo' [Param "--directory"] {- Finds all files in the specified locations, whether checked into git or - not. -} -allFiles :: [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool) -allFiles l repo = guardSafeForLsFiles repo $ pipeNullSplit' params repo - where - params = - Param "ls-files" : - Param "--cached" : - Param "--others" : - Param "-z" : - Param "--" : - map (File . fromRawFilePath) l +allFiles :: [Options] -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool) +allFiles = inRepo' [Param "--cached", Param "--others"] {- Returns a list of files in the specified locations that have been - deleted. -} -deleted :: [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool) -deleted l repo = guardSafeForLsFiles repo $ pipeNullSplit' params repo - where - params = - Param "ls-files" : - Param "--deleted" : - Param "-z" : - Param "--" : - map (File . fromRawFilePath) l +deleted :: [Options] -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool) +deleted = inRepo' [Param "--deleted"] {- Returns a list of files in the specified locations that have been - modified. -} -modified :: [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool) -modified l repo = guardSafeForLsFiles repo $ pipeNullSplit' params repo - where - params = - Param "ls-files" : - Param "--modified" : - Param "-z" : - Param "--" : - map (File . fromRawFilePath) l - -{- Files that have been modified or are not checked into git (and are not - - ignored). -} -modifiedOthers :: [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool) -modifiedOthers l repo = guardSafeForLsFiles repo $ pipeNullSplit' params repo - where - params = - Param "ls-files" : - Param "--modified" : - Param "--others" : - Param "--exclude-standard" : - Param "-z" : - Param "--" : - map (File . fromRawFilePath) l +modified :: [Options] -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool) +modified = inRepo' [Param "--modified"] {- Returns a list of all files that are staged for commit. -} staged :: [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool) @@ -177,11 +138,6 @@ staged' ps l repo = guardSafeForLsFiles repo $ type StagedDetails = (RawFilePath, Maybe Sha, Maybe FileMode) -{- Returns details about files that are staged in the index, - - as well as files not yet in git. Skips ignored files. -} -stagedOthersDetails :: [RawFilePath] -> Repo -> IO ([StagedDetails], IO Bool) -stagedOthersDetails = stagedDetails' [Param "--others", Param "--exclude-standard"] - {- Returns details about all files that are staged in the index. -} stagedDetails :: [RawFilePath] -> Repo -> IO ([StagedDetails], IO Bool) stagedDetails = stagedDetails' [] diff --git a/NEWS b/NEWS index 5dd3f7843f..e19222baf8 100644 --- a/NEWS +++ b/NEWS @@ -1,3 +1,14 @@ +git-annex (8.20200523) UNRELEASED; urgency=medium + + Transition notice: Commands like `git-annex get foo*` silently skip over + files that are not checked into git. Since that can be surprising in many + cases, the behavior will change to erroring out when one of the listed + files is not checked into git. This change is planned for a git-annex + release in early 2022. If you would like to keep the current + behavior, use git config to set annex.skipunknown to true. + + -- Joey Hess Thu, 28 May 2020 13:23:40 -0400 + git-annex (8.20200226) upstream; urgency=medium This version of git-annex uses repository version 8 for all repositories. diff --git a/Types/GitConfig.hs b/Types/GitConfig.hs index 35e9ad91c7..7f061321cf 100644 --- a/Types/GitConfig.hs +++ b/Types/GitConfig.hs @@ -123,6 +123,7 @@ data GitConfig = GitConfig , annexCacheCreds :: Bool , annexAutoUpgradeRepository :: Bool , annexCommitMode :: CommitMode + , annexSkipUnknown :: Bool , coreSymlinks :: Bool , coreSharedRepository :: SharedRepository , receiveDenyCurrentBranch :: DenyCurrentBranch @@ -214,6 +215,7 @@ extractGitConfig configsource r = GitConfig , annexCommitMode = if getbool (annexConfig "allowsign") False then ManualCommit else AutomaticCommit + , annexSkipUnknown = getbool (annexConfig "skipunknown") True , coreSymlinks = getbool "core.symlinks" True , coreSharedRepository = getSharedRepository r , receiveDenyCurrentBranch = getDenyCurrentBranch r diff --git a/Upgrade/V1.hs b/Upgrade/V1.hs index ddf54aa123..4b85bf91b6 100644 --- a/Upgrade/V1.hs +++ b/Upgrade/V1.hs @@ -85,7 +85,7 @@ updateSymlinks :: Annex () updateSymlinks = do showAction "updating symlinks" top <- fromRepo Git.repoPath - (files, cleanup) <- inRepo $ LsFiles.inRepo [top] + (files, cleanup) <- inRepo $ LsFiles.inRepo [] [top] forM_ files (fixlink . fromRawFilePath) void $ liftIO cleanup where diff --git a/doc/bugs/annex_metadata___40__not_--batch__39__ed__41___is_not_aware_of_files_added_via_addurls_--batch.mdwn b/doc/bugs/annex_metadata___40__not_--batch__39__ed__41___is_not_aware_of_files_added_via_addurls_--batch.mdwn index ccd1761860..9f1c014ce5 100644 --- a/doc/bugs/annex_metadata___40__not_--batch__39__ed__41___is_not_aware_of_files_added_via_addurls_--batch.mdwn +++ b/doc/bugs/annex_metadata___40__not_--batch__39__ed__41___is_not_aware_of_files_added_via_addurls_--batch.mdwn @@ -35,3 +35,12 @@ P.S. It might be a related observation that git-annex metadata does exit with n [[!tag projects/datalad]] [[!meta title="silently skipping files that are not in git or not annexed is sometimes surprising to some"]] + +> annex.skipunknown false will make git-annex error out in this situation. +> That will become the default in a couple of years, but can be set already +> by those who don't like the behavior of skipping. +> +> In the case of addurl --batch though, do see my first comment for a way to +> avoid any errors. +> +> [[done]] --[[Joey]] diff --git a/doc/bugs/annex_metadata___40__not_--batch__39__ed__41___is_not_aware_of_files_added_via_addurls_--batch/comment_2_c479f19eb55dce35364eea30d0b727b7._comment b/doc/bugs/annex_metadata___40__not_--batch__39__ed__41___is_not_aware_of_files_added_via_addurls_--batch/comment_2_c479f19eb55dce35364eea30d0b727b7._comment index 72e70669ed..c85c646c50 100644 --- a/doc/bugs/annex_metadata___40__not_--batch__39__ed__41___is_not_aware_of_files_added_via_addurls_--batch/comment_2_c479f19eb55dce35364eea30d0b727b7._comment +++ b/doc/bugs/annex_metadata___40__not_--batch__39__ed__41___is_not_aware_of_files_added_via_addurls_--batch/comment_2_c479f19eb55dce35364eea30d0b727b7._comment @@ -27,7 +27,8 @@ temp file that is not in git, then they would have to change scripts and workflows. Implementing it may be as simple as passing --error-unmatch to git -ls-files. +ls-files. (And disable git-annex's code that checks for parameters that are +not existing files.) It could be an option, but I don't really consider an option as fixing the surprising behavior. And once you know git-annex behaves this way, I think diff --git a/doc/bugs/annex_metadata___40__not_--batch__39__ed__41___is_not_aware_of_files_added_via_addurls_--batch/comment_3_f694e35efa09aa60daf17d63270968af._comment b/doc/bugs/annex_metadata___40__not_--batch__39__ed__41___is_not_aware_of_files_added_via_addurls_--batch/comment_3_f694e35efa09aa60daf17d63270968af._comment new file mode 100644 index 0000000000..b2cc47571a --- /dev/null +++ b/doc/bugs/annex_metadata___40__not_--batch__39__ed__41___is_not_aware_of_files_added_via_addurls_--batch/comment_3_f694e35efa09aa60daf17d63270968af._comment @@ -0,0 +1,17 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 3""" + date="2020-05-28T19:49:58Z" + content=""" +Implemented annex.skipunknown git config, that will make it error out when +given a file that git doesn't know about. + +Not default yet, will be in a couple of years. +[[todo/complete_annex.skipunknown_transition_in_2022]] + +As to git-annex skipping non-annexed files, I'm leaning toward keeping it +the way it is, and it's not really the subject of this bug report, except +maybe that it's not entirely consistent with the annex.skipunknown +behavior for non-git files. If users complain about it, I'll consider it +again. +"""]] diff --git a/doc/bugs/unlock_should_warn_if_file_isn__39__t_in_repo.mdwn b/doc/bugs/unlock_should_warn_if_file_isn__39__t_in_repo.mdwn index 8ddbf85cba..c131e226c4 100644 --- a/doc/bugs/unlock_should_warn_if_file_isn__39__t_in_repo.mdwn +++ b/doc/bugs/unlock_should_warn_if_file_isn__39__t_in_repo.mdwn @@ -51,3 +51,7 @@ It would be nice if git-annex could give an error to explain why the unlock fail ### Have you had any luck using git-annex before? (Sometimes we get tired of reading bug reports all day and a lil' positive end note does wonders) git-annex is amazing, I use it all the time. Thanks! + +> annex.skipunknown false will make git-annex error out in this situation. +> That will become the default in a couple of years, but can be set already +> by those who don't like the behavior of skipping. [[done]] --[[Joey]] diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 3703bcd156..8eae776463 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -880,6 +880,28 @@ Like other git commands, git-annex is configured via `.git/config`. The default reserve is 1 megabyte. +* `annex.skipunknown` + + Set to true to make commands like "git-annex get" silently skip over + items that are listed in the command line, but are not checked into git. + + Set to false to make it an error for commands like "git-annex get" + to be asked to operate on files that are not checked into git. + + The default is currently true, but is planned to change to false in a + release in 2022. + + Note that, when annex.skipunknown is false, a command like "git-annex get ." + will fail if no files in the current directory are checked into git, + but a command like "git-annex get" will not fail, because the current + directory is not listed, but is implicit. Commands like "git-annex get foo/" + will fail if no files in the directory are checked into git, but if + at least one file is, it will ignore other files that are not. This is + all the same as the behavior of "git-ls files --error-unmatch". + + Also note that git-annex skips files that are checked into git, but are + not annexed files, this setting does not affect that. + * `annex.largefiles` Used to configure which files are large enough to be added to the annex. diff --git a/doc/todo/complete_annex.skipunknown_transition_in_2022.mdwn b/doc/todo/complete_annex.skipunknown_transition_in_2022.mdwn new file mode 100644 index 0000000000..9d5f13dc24 --- /dev/null +++ b/doc/todo/complete_annex.skipunknown_transition_in_2022.mdwn @@ -0,0 +1,4 @@ +annex.skipunknown should be changed to default to false in early 2022. +This transition was started in mid 2020 and there should have been plenty +of time for people to learn about it and either set their preferred +behavior or change workflows for the new behavior.