diff --git a/Annex.hs b/Annex.hs index d642885bc8..efb3cc6a4b 100644 --- a/Annex.hs +++ b/Annex.hs @@ -118,7 +118,7 @@ data AnnexState = AnnexState , catfilehandles :: M.Map FilePath CatFileHandle , hashobjecthandle :: Maybe HashObjectHandle , checkattrhandle :: Maybe CheckAttrHandle - , checkignorehandle :: Maybe (Maybe CheckIgnoreHandle) + , checkignorehandle :: Maybe CheckIgnoreHandle , forcebackend :: Maybe String , globalnumcopies :: Maybe NumCopies , forcenumcopies :: Maybe NumCopies diff --git a/Annex/AdjustedBranch.hs b/Annex/AdjustedBranch.hs index 9cc449b0d9..cc041e5022 100644 --- a/Annex/AdjustedBranch.hs +++ b/Annex/AdjustedBranch.hs @@ -26,7 +26,6 @@ module Annex.AdjustedBranch ( propigateAdjustedCommits, AdjustedClone(..), checkAdjustedClone, - isSupported, checkVersionSupported, isGitVersionSupported, ) where @@ -50,7 +49,6 @@ import Git.Index import Git.FilePath import qualified Git.LockFile import qualified Git.Version -import Annex.Version import Annex.CatFile import Annex.Link import Annex.AutoMerge @@ -572,7 +570,7 @@ diffTreeToTreeItem dti = TreeItem (Git.DiffTree.dstmode dti) (Git.DiffTree.dstsha dti) -data AdjustedClone = InAdjustedClone | NotInAdjustedClone | NeedUpgradeForAdjustedClone +data AdjustedClone = InAdjustedClone | NotInAdjustedClone {- Cloning a repository that has an adjusted branch checked out will - result in the clone having the same adjusted branch checked out -- but @@ -611,18 +609,10 @@ checkAdjustedClone = ifM isBareRepo case aps of Just [p] -> setBasisBranch basis p _ -> giveup $ "Unable to clean up from clone of adjusted branch; perhaps you should check out " ++ Git.Ref.describe origbranch - ifM versionSupportsUnlockedPointers - ( return InAdjustedClone - , return NeedUpgradeForAdjustedClone - ) - -isSupported :: Annex Bool -isSupported = versionSupportsAdjustedBranch <&&> liftIO isGitVersionSupported + return InAdjustedClone checkVersionSupported :: Annex () -checkVersionSupported = do - unlessM versionSupportsAdjustedBranch $ - giveup "Adjusted branches are only supported in v6 or newer repositories." +checkVersionSupported = unlessM (liftIO isGitVersionSupported) $ giveup "Your version of git is too old; upgrade it to 2.2.0 or newer to use adjusted branches." diff --git a/Annex/CheckIgnore.hs b/Annex/CheckIgnore.hs index c8cd08c7d4..4745470687 100644 --- a/Annex/CheckIgnore.hs +++ b/Annex/CheckIgnore.hs @@ -19,23 +19,19 @@ import qualified Annex checkIgnored :: FilePath -> Annex Bool checkIgnored file = go =<< checkIgnoreHandle where - go Nothing = return False - go (Just h) = liftIO $ Git.checkIgnored h file + go h = liftIO $ Git.checkIgnored h file -checkIgnoreHandle :: Annex (Maybe Git.CheckIgnoreHandle) +checkIgnoreHandle :: Annex Git.CheckIgnoreHandle checkIgnoreHandle = maybe startup return =<< Annex.getState Annex.checkignorehandle where startup = do - v <- inRepo Git.checkIgnoreStart - when (isNothing v) $ - warning "The installed version of git is too old for .gitignores to be honored by git-annex." - Annex.changeState $ \s -> s { Annex.checkignorehandle = Just v } - return v + h <- inRepo Git.checkIgnoreStart + Annex.changeState $ \s -> s { Annex.checkignorehandle = Just h } + return h checkIgnoreStop :: Annex () checkIgnoreStop = maybe noop stop =<< Annex.getState Annex.checkignorehandle where - stop (Just h) = do + stop h = do liftIO $ Git.checkIgnoreStop h Annex.changeState $ \s -> s { Annex.checkignorehandle = Nothing } - stop Nothing = noop diff --git a/Annex/Fixup.hs b/Annex/Fixup.hs index 449c28491c..d167086b09 100644 --- a/Annex/Fixup.hs +++ b/Annex/Fixup.hs @@ -12,7 +12,6 @@ import Git.Config import Types.GitConfig import Config.Files import qualified Git -import qualified Git.BuildVersion import Utility.Path import Utility.SafeCommand import Utility.Directory @@ -42,10 +41,8 @@ fixupRepo r c = do {- Disable git's built-in wildcard expansion, which is not wanted - when using it as plumbing by git-annex. -} disableWildcardExpansion :: Repo -> Repo -disableWildcardExpansion r - | Git.BuildVersion.older "1.8.1" = r - | otherwise = r - { gitGlobalOpts = gitGlobalOpts r ++ [Param "--literal-pathspecs"] } +disableWildcardExpansion r = r + { gitGlobalOpts = gitGlobalOpts r ++ [Param "--literal-pathspecs"] } {- Direct mode repos have core.bare=true, but are not really bare. - Fix up the Repo to be a non-bare repo, and arrange for git commands diff --git a/Annex/Ingest.hs b/Annex/Ingest.hs index e3be3393fa..1406c4007c 100644 --- a/Annex/Ingest.hs +++ b/Annex/Ingest.hs @@ -31,7 +31,6 @@ import Annex.Perms import Annex.Link import Annex.MetaData import Annex.CurrentBranch -import Annex.Version import Logs.Location import qualified Annex import qualified Annex.Queue @@ -308,11 +307,9 @@ forceParams = ifM (Annex.getState Annex.force) -} addUnlocked :: Annex Bool addUnlocked = - (versionSupportsUnlockedPointers <&&> - ((not . coreSymlinks <$> Annex.getGitConfig) <||> - (annexAddUnlocked <$> Annex.getGitConfig) <||> - (maybe False isadjustedunlocked . snd <$> getCurrentBranch) - ) + ((not . coreSymlinks <$> Annex.getGitConfig) <||> + (annexAddUnlocked <$> Annex.getGitConfig) <||> + (maybe False isadjustedunlocked . snd <$> getCurrentBranch) ) where isadjustedunlocked (LinkAdjustment UnlockAdjustment) = True diff --git a/Annex/Init.hs b/Annex/Init.hs index 142078764d..1d4c4c8008 100644 --- a/Annex/Init.hs +++ b/Annex/Init.hs @@ -100,26 +100,20 @@ initialize' :: Maybe RepoVersion -> Annex () initialize' mversion = checkCanInitialize $ do checkLockSupport checkFifoSupport - checkCrippledFileSystem mversion + checkCrippledFileSystem unlessM isBareRepo $ do hookWrite preCommitHook hookWrite postReceiveHook setDifferences unlessM (isJust <$> getVersion) $ - ifM (crippledFileSystem <&&> (not <$> isBareRepo)) - ( setVersion (fromMaybe versionForCrippledFilesystem mversion) - , setVersion (fromMaybe defaultVersion mversion) - ) - whenM versionSupportsUnlockedPointers $ do - configureSmudgeFilter - showSideAction "scanning for unlocked files" - scanUnlockedFiles True - unlessM isBareRepo $ do - hookWrite postCheckoutHook - hookWrite postMergeHook + setVersion (fromMaybe defaultVersion mversion) + configureSmudgeFilter + showSideAction "scanning for unlocked files" + scanUnlockedFiles True + unlessM isBareRepo $ do + hookWrite postCheckoutHook + hookWrite postMergeHook AdjustedBranch.checkAdjustedClone >>= \case - AdjustedBranch.NeedUpgradeForAdjustedClone -> - void $ upgrade True versionForAdjustedClone AdjustedBranch.InAdjustedClone -> return () AdjustedBranch.NotInAdjustedClone -> ifM (crippledFileSystem <&&> (not <$> isBareRepo)) @@ -147,12 +141,7 @@ uninitialize = do - Checks repository version and handles upgrades too. -} ensureInitialized :: Annex () -ensureInitialized = do - getVersion >>= maybe needsinit checkUpgrade - whenM isDirect $ - unlessM (catchBoolIO $ upgrade True versionForAdjustedBranch) $ do - g <- Annex.gitRepo - giveup $ "Upgrading direct mode repository " ++ Git.repoDescribe g ++ " failed, and direct mode is no longer supported." +ensureInitialized = getVersion >>= maybe needsinit checkUpgrade where needsinit = ifM Annex.Branch.hasSibling ( initialize Nothing Nothing @@ -204,15 +193,9 @@ probeCrippledFileSystem' tmp = do ) #endif -checkCrippledFileSystem :: Maybe RepoVersion -> Annex () -checkCrippledFileSystem mversion = whenM probeCrippledFileSystem $ do +checkCrippledFileSystem :: Annex () +checkCrippledFileSystem = whenM probeCrippledFileSystem $ do warning "Detected a crippled filesystem." - - unlessM isBareRepo $ case mversion of - Just ver | ver < versionForCrippledFilesystem -> - giveup $ "Cannot use repo version " ++ show (fromRepoVersion ver) ++ " in a crippled filesystem." - _ -> noop - setCrippledFileSystem True {- Normally git disables core.symlinks itself when the diff --git a/Annex/UpdateInstead.hs b/Annex/UpdateInstead.hs index 7dde49e240..3f197cb580 100644 --- a/Annex/UpdateInstead.hs +++ b/Annex/UpdateInstead.hs @@ -9,7 +9,6 @@ module Annex.UpdateInstead where import qualified Annex import Annex.Common -import Annex.Version import Annex.AdjustedBranch import Git.Branch import Git.ConfigTypes @@ -21,5 +20,4 @@ needUpdateInsteadEmulation = updateinsteadset <&&> isadjusted where updateinsteadset = (== UpdateInstead) . receiveDenyCurrentBranch <$> Annex.getGitConfig - isadjusted = versionSupportsUnlockedPointers - <&&> (maybe False (isJust . getAdjustment) <$> inRepo Git.Branch.current) + isadjusted = (maybe False (isJust . getAdjustment) <$> inRepo Git.Branch.current) diff --git a/Annex/Version.hs b/Annex/Version.hs index 9bc3a5f3de..6e0fd4f530 100644 --- a/Annex/Version.hs +++ b/Annex/Version.hs @@ -17,22 +17,13 @@ import qualified Annex import qualified Data.Map as M defaultVersion :: RepoVersion -defaultVersion = RepoVersion 5 +defaultVersion = RepoVersion 7 latestVersion :: RepoVersion latestVersion = RepoVersion 7 supportedVersions :: [RepoVersion] -supportedVersions = map RepoVersion [5, 7] - -versionForAdjustedClone :: RepoVersion -versionForAdjustedClone = RepoVersion 7 - -versionForAdjustedBranch :: RepoVersion -versionForAdjustedBranch = RepoVersion 7 - -versionForCrippledFilesystem :: RepoVersion -versionForCrippledFilesystem = RepoVersion 7 +supportedVersions = map RepoVersion [7] upgradableVersions :: [RepoVersion] #ifndef mingw32_HOST_OS @@ -45,6 +36,7 @@ autoUpgradeableVersions :: M.Map RepoVersion RepoVersion autoUpgradeableVersions = M.fromList [ (RepoVersion 3, RepoVersion 5) , (RepoVersion 4, RepoVersion 5) + , (RepoVersion 5, RepoVersion 6) , (RepoVersion 6, RepoVersion 7) ] @@ -54,18 +46,6 @@ versionField = annexConfig "version" getVersion :: Annex (Maybe RepoVersion) getVersion = annexVersion <$> Annex.getGitConfig -versionSupportsUnlockedPointers :: Annex Bool -versionSupportsUnlockedPointers = go <$> getVersion - where - go (Just v) | v >= RepoVersion 6 = True - go _ = False - -versionSupportsAdjustedBranch :: Annex Bool -versionSupportsAdjustedBranch = versionSupportsUnlockedPointers - -versionUsesKeysDatabase :: Annex Bool -versionUsesKeysDatabase = versionSupportsUnlockedPointers - setVersion :: RepoVersion -> Annex () setVersion (RepoVersion v) = setConfig versionField (show v) diff --git a/Annex/WorkTree.hs b/Annex/WorkTree.hs index 23a4ec1e26..eb64e0cbb1 100644 --- a/Annex/WorkTree.hs +++ b/Annex/WorkTree.hs @@ -10,7 +10,6 @@ module Annex.WorkTree where import Annex.Common import Annex.Link import Annex.CatFile -import Annex.Version import Annex.Content import Annex.ReplaceFile import Annex.CurrentBranch @@ -54,10 +53,7 @@ lookupFileNotHidden = lookupFile' catkeyfile lookupFile' :: (FilePath -> Annex (Maybe Key)) -> FilePath -> Annex (Maybe Key) lookupFile' catkeyfile file = isAnnexLink file >>= \case Just key -> return (Just key) - Nothing -> ifM versionSupportsUnlockedPointers - ( catkeyfile file - , return Nothing - ) + Nothing -> catkeyfile file {- Modifies an action to only act on files that are already annexed, - and passes the key on to it. -} diff --git a/Assistant/MakeRepo.hs b/Assistant/MakeRepo.hs index 156991cca1..372f216630 100644 --- a/Assistant/MakeRepo.hs +++ b/Assistant/MakeRepo.hs @@ -17,8 +17,6 @@ import qualified Annex import Annex.UUID import Annex.AdjustedBranch import Annex.Action -import Annex.Version -import Upgrade import Types.StandardGroups import Logs.PreferredContent import qualified Annex.Branch @@ -62,14 +60,13 @@ initRepo True primary_assistant_repo dir desc mgroup = inDir dir $ do , Param "-m" , Param "created repository" ] - {- Repositories directly managed by the assistant use v7 unlocked - - with annex.thin set. + {- Repositories directly managed by the assistant use + - an adjusted unlocked branch with annex.thin set. - - Automatic gc is disabled, as it can be slow. Insted, gc is done - once a day. -} when primary_assistant_repo $ do - void $ upgrade True versionForAdjustedBranch void $ enterAdjustedBranch (LinkAdjustment UnlockAdjustment) setConfig (annexConfig "thin") (Git.Config.boolConfig True) inRepo $ Git.Command.run diff --git a/Assistant/Threads/Committer.hs b/Assistant/Threads/Committer.hs index 5a07893266..a81f21f65c 100644 --- a/Assistant/Threads/Committer.hs +++ b/Assistant/Threads/Committer.hs @@ -20,7 +20,6 @@ import Assistant.Drop import Types.Transfer import Logs.Location import qualified Annex.Queue -import qualified Git.LsFiles import Utility.ThreadScheduler import qualified Utility.Lsof as Lsof import qualified Utility.DirWatcher as DirWatcher @@ -32,7 +31,6 @@ import Annex.Link import Annex.Perms import Annex.CatFile import Annex.InodeSentinal -import Annex.Version import Annex.CurrentBranch import qualified Annex import Utility.InodeCache @@ -53,8 +51,7 @@ commitThread :: NamedThread commitThread = namedThread "Committer" $ do havelsof <- liftIO $ inPath "lsof" delayadd <- liftAnnex $ - maybe delayaddDefault (return . Just . Seconds) - =<< annexDelayAdd <$> Annex.getGitConfig + fmap Seconds . annexDelayAdd <$> Annex.getGitConfig msg <- liftAnnex Command.Sync.commitMsg lockdowndir <- liftAnnex $ fromRepo gitAnnexTmpWatcherDir liftAnnex $ do @@ -239,19 +236,6 @@ commitStaged msg = do Command.Sync.updateBranches =<< getCurrentBranch return ok -{- OSX needs a short delay after a file is added before locking it down, - - as pasting a file seems to try to set file permissions or otherwise - - access the file after closing it. -} -delayaddDefault :: Annex (Maybe Seconds) -#ifdef darwin_HOST_OS -delayaddDefault = ifM versionSupportsUnlockedPointers - ( return Nothing - , return $ Just $ Seconds 1 - ) -#else -delayaddDefault = return Nothing -#endif - {- If there are PendingAddChanges, or InProcessAddChanges, the files - have not yet actually been added to the annex, and that has to be done - now, before committing. @@ -274,49 +258,22 @@ delayaddDefault = return Nothing handleAdds :: FilePath -> Bool -> Maybe Seconds -> [Change] -> Assistant [Change] handleAdds lockdowndir havelsof delayadd cs = returnWhen (null incomplete) $ do let (pending, inprocess) = partition isPendingAddChange incomplete - unlocked <- liftAnnex versionSupportsUnlockedPointers - let lockingfiles = not unlocked let lockdownconfig = LockDownConfig - { lockingFile = lockingfiles + { lockingFile = False , hardlinkFileTmpDir = Just lockdowndir } - (pending', cleanup) <- if unlocked - then return (pending, noop) - else findnew pending (postponed, toadd) <- partitionEithers - <$> safeToAdd lockdowndir lockdownconfig havelsof delayadd pending' inprocess - cleanup + <$> safeToAdd lockdowndir lockdownconfig havelsof delayadd pending inprocess unless (null postponed) $ refillChanges postponed returnWhen (null toadd) $ do added <- addaction toadd $ - catMaybes <$> - if not lockingfiles - then addunlocked toadd - else forM toadd (add lockdownconfig) - if DirWatcher.eventsCoalesce || null added || unlocked - then return $ added ++ otherchanges - else do - r <- handleAdds lockdowndir havelsof delayadd =<< getChanges - return $ r ++ added ++ otherchanges + catMaybes <$> addunlocked toadd + return $ added ++ otherchanges where (incomplete, otherchanges) = partition (\c -> isPendingAddChange c || isInProcessAddChange c) cs - - -- Find files that are actually new, and not unlocked annexed - -- files. The ls-files is run on a batch of files. - findnew [] = return ([], noop) - findnew pending@(exemplar:_) = do - let segments = segmentXargsUnordered $ map changeFile pending - rs <- liftAnnex $ forM segments $ \fs -> - inRepo (Git.LsFiles.notInRepo False fs) - let (newfiles, cleanup) = foldl' - (\(l1, a1) (l2, a2) -> (l1 ++ l2, a1 >> a2)) - ([], return True) rs - -- note: timestamp info is lost here - let ts = changeTime exemplar - return (map (PendingAddChange ts) newfiles, void $ liftIO cleanup) returnWhen c a | c = return otherchanges @@ -328,10 +285,10 @@ handleAdds lockdowndir havelsof delayadd cs = returnWhen (null incomplete) $ do where ks = keySource ld doadd = sanitycheck ks $ do - (mkey, mcache) <- liftAnnex $ do + (mkey, _mcache) <- liftAnnex $ do showStart "add" $ keyFilename ks ingest nullMeterUpdate (Just $ LockedDown lockdownconfig ks) Nothing - maybe (failedingest change) (done change mcache $ keyFilename ks) mkey + maybe (failedingest change) (done change $ keyFilename ks) mkey add _ _ = return Nothing {- Avoid overhead of re-injesting a renamed unlocked file, by @@ -363,7 +320,7 @@ handleAdds lockdowndir havelsof delayadd cs = returnWhen (null incomplete) $ do fastadd change key = do let source = keySource $ lockedDown change liftAnnex $ finishIngestUnlocked key source - done change Nothing (keyFilename source) key + done change (keyFilename source) key removedKeysMap :: InodeComparisonType -> [Change] -> Annex (M.Map InodeCacheKey Key) removedKeysMap ct l = do @@ -379,17 +336,10 @@ handleAdds lockdowndir havelsof delayadd cs = returnWhen (null incomplete) $ do liftAnnex showEndFail return Nothing - done change mcache file key = liftAnnex $ do + done change file key = liftAnnex $ do logStatus key InfoPresent - ifM versionSupportsUnlockedPointers - ( do - mode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus file - stagePointerFile file mode =<< hashPointerFile key - , do - link <- makeLink file key mcache - when DirWatcher.eventsCoalesce $ - stageSymlink file =<< hashSymlink link - ) + mode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus file + stagePointerFile file mode =<< hashPointerFile key showEndOk return $ Just $ finishedChange change key diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs index 93a137a5f5..cef02f0b20 100644 --- a/Assistant/Threads/Watcher.hs +++ b/Assistant/Threads/Watcher.hs @@ -36,7 +36,6 @@ import Annex.Link import Annex.FileMatcher import Annex.Content import Annex.ReplaceFile -import Annex.Version import Annex.InodeSentinal import Git.Types import Git.FilePath @@ -90,11 +89,8 @@ runWatcher :: Assistant () runWatcher = do startup <- asIO1 startupScan matcher <- liftAnnex largeFilesMatcher - unlocked <- liftAnnex versionSupportsUnlockedPointers symlinkssupported <- liftAnnex $ coreSymlinks <$> Annex.getGitConfig - addhook <- hook $ if unlocked - then onAddUnlocked symlinkssupported matcher - else onAdd matcher + addhook <- hook $ onAddUnlocked symlinkssupported matcher delhook <- hook onDel addsymlinkhook <- hook onAddSymlink deldirhook <- hook onDelDir @@ -205,13 +201,6 @@ add largefilematcher file = ifM (liftAnnex $ checkFileMatcher largefilematcher f madeChange file AddFileChange ) -onAdd :: GetFileMatcher -> Handler -onAdd matcher file filestatus - | maybe False isRegularFile filestatus = - unlessIgnored file $ - add matcher file - | otherwise = noChange - shouldRestage :: DaemonStatus -> Bool shouldRestage ds = scanComplete ds || forceRestage ds @@ -356,8 +345,7 @@ onDel file _ = do onDel' :: FilePath -> Annex () onDel' file = do topfile <- inRepo (toTopFilePath file) - whenM versionSupportsUnlockedPointers $ - withkey $ flip Database.Keys.removeAssociatedFile topfile + withkey $ flip Database.Keys.removeAssociatedFile topfile Annex.Queue.addUpdateIndex =<< inRepo (Git.UpdateIndex.unstageFile file) where diff --git a/Build/Configure.hs b/Build/Configure.hs index 3edb0f28e8..6efd593c33 100644 --- a/Build/Configure.hs +++ b/Build/Configure.hs @@ -62,7 +62,7 @@ getGitVersion = go =<< getEnv "FORCE_GIT_VERSION" go (Just s) = return $ Config "gitversion" $ StringConfig s go Nothing = do v <- Git.Version.installed - let oldestallowed = Git.Version.normalize "1.7.1.0" + let oldestallowed = Git.Version.normalize "2.1" when (v < oldestallowed) $ error $ "installed git version " ++ show v ++ " is too old! (Need " ++ show oldestallowed ++ " or newer)" return $ Config "gitversion" $ StringConfig $ show v diff --git a/CHANGELOG b/CHANGELOG index f3ba674150..68d7d5d503 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -1,7 +1,11 @@ git-annex (7.20190826) UNRELEASED; urgency=medium + * Default to v7 for new repositories. + * Automatically upgrade v5 repositories to v7. * Automatically convert direct mode repositories to v7 with adjusted unlocked branches and set annex.thin. + * Added annex.autoupgraderepository configuration that can be set to false + to prevent any automatic repository upgrades. * Refuse to upgrade direct mode repositories when git is older than 2.22, which fixed a memory leak that could cause an OOM during the upgrade. * assistant: When creating a new repository, no longer use direct @@ -27,6 +31,7 @@ git-annex (7.20190826) UNRELEASED; urgency=medium * init: Catch more exceptions when testing locking. * init: Fix a reversion that broke initialization on systems that need to use pid locking. + * Removed support for git versions older than 2.1. -- Joey Hess Sat, 24 Aug 2019 12:54:35 -0400 diff --git a/CmdLine/Seek.hs b/CmdLine/Seek.hs index 9196a6dcc1..4107e9dcd6 100644 --- a/CmdLine/Seek.hs +++ b/CmdLine/Seek.hs @@ -114,38 +114,21 @@ withFilesToBeCommitted :: (FilePath -> CommandSeek) -> [WorkTreeItem] -> Command withFilesToBeCommitted a l = seekActions $ prepFiltered a $ seekHelper LsFiles.stagedNotDeleted l -withFilesOldUnlocked :: (FilePath -> CommandSeek) -> [WorkTreeItem] -> CommandSeek -withFilesOldUnlocked = withFilesOldUnlocked' LsFiles.typeChanged - -{- Unlocked files before v6 have changed type from a symlink to a regular file. - - - - Furthermore, unlocked files used to be a git-annex symlink, - - not some other sort of symlink. - -} -withFilesOldUnlocked' :: ([FilePath] -> Git.Repo -> IO ([FilePath], IO Bool)) -> (FilePath -> CommandSeek) -> [WorkTreeItem] -> CommandSeek -withFilesOldUnlocked' typechanged a l = seekActions $ - prepFiltered a unlockedfiles - where - unlockedfiles = filterM isOldUnlocked =<< seekHelper typechanged l - isOldUnlocked :: FilePath -> Annex Bool isOldUnlocked f = liftIO (notSymlink f) <&&> (isJust <$> catKeyFile f <||> isJust <$> catKeyFileHEAD f) -withFilesOldUnlockedToBeCommitted :: (FilePath -> CommandSeek) -> [WorkTreeItem] -> CommandSeek -withFilesOldUnlockedToBeCommitted = withFilesOldUnlocked' LsFiles.typeChangedStaged - -{- v6 unlocked pointer files that are staged, and whose content has not been +{- unlocked pointer files that are staged, and whose content has not been - modified-} withUnmodifiedUnlockedPointers :: (FilePath -> CommandSeek) -> [WorkTreeItem] -> CommandSeek withUnmodifiedUnlockedPointers a l = seekActions $ prepFiltered a unlockedfiles where - unlockedfiles = filterM isV6UnmodifiedUnlocked + unlockedfiles = filterM isUnmodifiedUnlocked =<< seekHelper LsFiles.typeChangedStaged l -isV6UnmodifiedUnlocked :: FilePath -> Annex Bool -isV6UnmodifiedUnlocked f = catKeyFile f >>= \case +isUnmodifiedUnlocked :: FilePath -> Annex Bool +isUnmodifiedUnlocked f = catKeyFile f >>= \case Nothing -> return False Just k -> sameInodeCache f =<< Database.Keys.getInodeCaches k diff --git a/Command/Add.hs b/Command/Add.hs index f219717083..200f66e768 100644 --- a/Command/Add.hs +++ b/Command/Add.hs @@ -16,7 +16,6 @@ import qualified Annex.Queue import qualified Database.Keys import Annex.FileMatcher import Annex.Link -import Annex.Version import Annex.Tmp import Messages.Progress import Git.FilePath @@ -69,10 +68,7 @@ seek o = startConcurrency commandStages $ do unless (updateOnly o) $ go (withFilesNotInGit (not $ includeDotFiles o)) go withFilesMaybeModified - ifM versionSupportsUnlockedPointers - ( go withUnmodifiedUnlockedPointers - , go withFilesOldUnlocked - ) + go withUnmodifiedUnlockedPointers {- Pass file off to git-add. -} startSmall :: FilePath -> CommandStart @@ -92,12 +88,8 @@ addFile file = do start :: FilePath -> CommandStart start file = do - ifM versionSupportsUnlockedPointers - ( do - mk <- liftIO $ isPointerFile file - maybe go fixuppointer mk - , go - ) + mk <- liftIO $ isPointerFile file + maybe go fixuppointer mk where go = ifAnnexed file addpresent add add = liftIO (catchMaybeIO $ getSymbolicLinkStatus file) >>= \case @@ -109,12 +101,10 @@ start file = do if isSymbolicLink s then next $ addFile file else perform file - addpresent key = ifM versionSupportsUnlockedPointers - ( liftIO (catchMaybeIO $ getSymbolicLinkStatus file) >>= \case + addpresent key = + liftIO (catchMaybeIO $ getSymbolicLinkStatus file) >>= \case Just s | isSymbolicLink s -> fixuplink key _ -> add - , fixuplink key - ) fixuplink key = starting "add" (ActionItemWorkTreeFile file) $ do -- the annexed symlink is present but not yet added to git liftIO $ removeFile file diff --git a/Command/Fix.hs b/Command/Fix.hs index 1711f5bd4d..c3f818b01b 100644 --- a/Command/Fix.hs +++ b/Command/Fix.hs @@ -12,7 +12,6 @@ module Command.Fix where import Command import Config import qualified Annex -import Annex.Version import Annex.ReplaceFile import Annex.Content import Annex.Perms @@ -32,12 +31,8 @@ cmd = noCommit $ withGlobalOptions [annexedMatchingOptions] $ seek :: CmdParams -> CommandSeek seek ps = unlessM crippledFileSystem $ do - fixwhat <- ifM versionSupportsUnlockedPointers - ( return FixAll - , return FixSymlinks - ) withFilesInGit - (commandAction . (whenAnnexed $ start fixwhat)) + (commandAction . (whenAnnexed $ start FixAll)) =<< workTreeItems ps data FixWhat = FixSymlinks | FixAll diff --git a/Command/Lock.hs b/Command/Lock.hs index 7932673270..2f2eab21b4 100644 --- a/Command/Lock.hs +++ b/Command/Lock.hs @@ -10,7 +10,6 @@ module Command.Lock where import Command import qualified Annex.Queue import qualified Annex -import Annex.Version import Annex.Content import Annex.Link import Annex.InodeSentinal @@ -31,12 +30,7 @@ cmd = withGlobalOptions [jsonOptions, annexedMatchingOptions] $ seek :: CmdParams -> CommandSeek seek ps = do l <- workTreeItems ps - ifM versionSupportsUnlockedPointers - ( withFilesInGit (commandAction . (whenAnnexed startNew)) l - , do - withFilesOldUnlocked (commandAction . startOld) l - withFilesOldUnlockedToBeCommitted (commandAction . startOld) l - ) + withFilesInGit (commandAction . (whenAnnexed startNew)) l startNew :: FilePath -> Key -> CommandStart startNew file key = ifM (isJust <$> isAnnexLink file) diff --git a/Command/PreCommit.hs b/Command/PreCommit.hs index e65723740b..8c366ec14b 100644 --- a/Command/PreCommit.hs +++ b/Command/PreCommit.hs @@ -10,21 +10,17 @@ module Command.PreCommit where import Command -import qualified Command.Add import qualified Command.Fix import qualified Command.Smudge import Annex.Hook import Annex.Link import Annex.View -import Annex.Version import Annex.View.ViewedFile import Annex.LockFile import Logs.View import Logs.MetaData import Types.View import Types.MetaData -import qualified Git.Index as Git -import qualified Git.LsFiles as Git import qualified Data.Set as S import qualified Data.Text as T @@ -37,31 +33,14 @@ cmd = command "pre-commit" SectionPlumbing seek :: CmdParams -> CommandSeek seek ps = lockPreCommitHook $ do - ifM (not <$> versionSupportsUnlockedPointers <&&> liftIO Git.haveFalseIndex) - ( do - (fs, cleanup) <- inRepo $ Git.typeChangedStaged ps - whenM (anyM isOldUnlocked fs) $ - giveup "Cannot make a partial commit with unlocked annexed files. You should `git annex add` the files you want to commit, and then run git commit." - void $ liftIO cleanup - , do - l <- workTreeItems ps - -- fix symlinks to files being committed - flip withFilesToBeCommitted l $ \f -> commandAction $ - maybe stop (Command.Fix.start Command.Fix.FixSymlinks f) - =<< isAnnexLink f - ifM versionSupportsUnlockedPointers - -- after a merge conflict or git - -- cherry-pick or stash, pointer - -- files in the worktree won't - -- be populated, so populate them - -- here - ( Command.Smudge.updateSmudged (Restage False) - -- inject unlocked files into the annex - -- (not needed when repo version uses - -- unlocked pointer files) - , withFilesOldUnlockedToBeCommitted (commandAction . startInjectUnlocked) l - ) - ) + l <- workTreeItems ps + -- fix symlinks to files being committed + flip withFilesToBeCommitted l $ \f -> commandAction $ + maybe stop (Command.Fix.start Command.Fix.FixSymlinks f) + =<< isAnnexLink f + -- after a merge conflict or git cherry-pick or stash, pointer + -- files in the worktree won't be populated, so populate them here + Command.Smudge.updateSmudged (Restage False) runAnnexHook preCommitAnnexHook @@ -73,12 +52,6 @@ seek ps = lockPreCommitHook $ do (addViewMetaData v) (removeViewMetaData v) -startInjectUnlocked :: FilePath -> CommandStart -startInjectUnlocked f = startingCustomOutput (ActionItemOther Nothing) $ do - unlessM (callCommandAction $ Command.Add.start f) $ - error $ "failed to add " ++ f ++ "; canceling commit" - next $ return True - addViewMetaData :: View -> ViewedFile -> Key -> CommandStart addViewMetaData v f k = starting "metadata" (mkActionItem (k, f)) $ next $ changeMetaData k $ fromView v f diff --git a/Command/Sync.hs b/Command/Sync.hs index 0e941a4300..d35986c0f3 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -458,8 +458,9 @@ pushRemote o remote (Just branch, _) = stopUnless (pure (pushOption o) <&&> need | remoteAnnexReadOnly gc = return False | not (remoteAnnexPush gc) = return False | otherwise = anyM (newer remote) [syncBranch branch, Annex.Branch.name] - -- Do updateInstead emulation for remotes on eg removable drives - -- formatted FAT, where the post-receive hook won't run. + -- Older remotes on crippled filesystems may not have a + -- post-receive hook set up, so when updateInstead emulation + -- is needed, run post-receive manually. postpushupdate repo = case Git.repoWorkTree repo of Nothing -> return True Just wt -> ifM needemulation diff --git a/Command/Unannex.hs b/Command/Unannex.hs index 92c3be75d4..cbb8cb5214 100644 --- a/Command/Unannex.hs +++ b/Command/Unannex.hs @@ -11,13 +11,8 @@ import Command import qualified Annex import Annex.Content import Annex.Perms -import Annex.Version import qualified Git.Command -import qualified Git.Branch -import qualified Git.Ref -import qualified Git.DiffTree as DiffTree import Utility.CopyFile -import Command.PreCommit (lockPreCommitHook) import qualified Database.Keys import Git.FilePath @@ -28,40 +23,7 @@ cmd = withGlobalOptions [annexedMatchingOptions] $ paramPaths (withParams seek) seek :: CmdParams -> CommandSeek -seek ps = wrapUnannex $ - (withFilesInGit $ commandAction . whenAnnexed start) =<< workTreeItems ps - -wrapUnannex :: Annex a -> Annex a -wrapUnannex a = ifM versionSupportsUnlockedPointers - ( a - {- Run with the pre-commit hook disabled, to avoid confusing - - behavior if an unannexed file is added back to git as - - a normal, non-annexed file and then committed. - - Otherwise, the pre-commit hook would think that the file - - has been unlocked and needs to be re-annexed. - - - - At the end, make a commit removing the unannexed files. - -} - , ifM cleanindex - ( lockPreCommitHook $ commit `after` a - , giveup "Cannot proceed with uncommitted changes staged in the index. Recommend you: git commit" - ) - ) - where - commit = inRepo $ Git.Branch.commitCommand Git.Branch.ManualCommit - [ Param "-q" - , Param "--allow-empty" - , Param "--no-verify" - , Param "-m", Param "content removed from git annex" - ] - cleanindex = ifM (inRepo Git.Ref.headExists) - ( do - (diff, reap) <- inRepo $ DiffTree.diffIndex Git.Ref.headRef - if null diff - then void (liftIO reap) >> return True - else void (liftIO reap) >> return False - , return False - ) +seek ps = (withFilesInGit $ commandAction . whenAnnexed start) =<< workTreeItems ps start :: FilePath -> Key -> CommandStart start file key = stopUnless (inAnnex key) $ diff --git a/Command/Unlock.hs b/Command/Unlock.hs index 05a4f3493b..2fc605c6de 100644 --- a/Command/Unlock.hs +++ b/Command/Unlock.hs @@ -10,11 +10,8 @@ module Command.Unlock where import Command import Annex.Content import Annex.Perms -import Annex.CatFile -import Annex.Version import Annex.Link import Annex.ReplaceFile -import Utility.CopyFile import Git.FilePath import qualified Database.Keys @@ -37,15 +34,12 @@ seek ps = withFilesInGit (commandAction . whenAnnexed start) =<< workTreeItems p start :: FilePath -> Key -> CommandStart start file key = ifM (isJust <$> isAnnexLink file) ( starting "unlock" (mkActionItem (key, AssociatedFile (Just file))) $ - ifM versionSupportsUnlockedPointers - ( performNew file key - , performOld file key - ) + perform file key , stop ) -performNew :: FilePath -> Key -> CommandPerform -performNew dest key = do +perform :: FilePath -> Key -> CommandPerform +perform dest key = do destmode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus dest replaceFile dest $ \tmp -> ifM (inAnnex key) @@ -57,47 +51,10 @@ performNew dest key = do LinkAnnexFailed -> error "unlock failed" , liftIO $ writePointerFile tmp key destmode ) - next $ cleanupNew dest key destmode + next $ cleanup dest key destmode -cleanupNew :: FilePath -> Key -> Maybe FileMode -> CommandCleanup -cleanupNew dest key destmode = do +cleanup :: FilePath -> Key -> Maybe FileMode -> CommandCleanup +cleanup dest key destmode = do stagePointerFile dest destmode =<< hashPointerFile key Database.Keys.addAssociatedFile key =<< inRepo (toTopFilePath dest) return True - -performOld :: FilePath -> Key -> CommandPerform -performOld file key = - ifM (inAnnex key) - ( ifM (isJust <$> catKeyFileHEAD file) - ( performOld' file key - , do - warning "this has not yet been committed to git; cannot unlock it" - next $ return False - ) - , do - warning "content not present; cannot unlock" - next $ return False - ) - -performOld' :: FilePath -> Key -> CommandPerform -performOld' dest key = ifM (checkDiskSpace Nothing key 0 True) - ( do - src <- calcRepo $ gitAnnexLocation key - tmpdest <- fromRepo $ gitAnnexTmpObjectLocation key - liftIO $ createDirectoryIfMissing True (parentDir tmpdest) - showAction "copying" - ifM (liftIO $ copyFileExternal CopyAllMetaData src tmpdest) - ( do - liftIO $ do - removeFile dest - moveFile tmpdest dest - thawContent dest - next $ return True - , do - warning "copy failed!" - next $ return False - ) - , do - warning "not enough disk space to copy file" - next $ return False - ) diff --git a/Command/Upgrade.hs b/Command/Upgrade.hs index 00e972ae5d..ead0c4b867 100644 --- a/Command/Upgrade.hs +++ b/Command/Upgrade.hs @@ -13,9 +13,13 @@ import Annex.Version import Annex.Init cmd :: Command -cmd = dontCheck repoExists $ -- because an old version may not seem to exist - noDaemonRunning $ -- avoid upgrading repo out from under daemon - command "upgrade" SectionMaintenance "upgrade repository layout" +cmd = dontCheck repoExists $ + -- ^ because an old version may not seem to exist + -- and also, this avoids automatic silent upgrades before + -- this command can start up. + noDaemonRunning $ + -- ^ avoid upgrading repo out from under daemon + command "upgrade" SectionMaintenance "upgrade repository" paramNothing (withParams seek) seek :: CmdParams -> CommandSeek diff --git a/Database/Keys.hs b/Database/Keys.hs index 77931365e9..e60724c2c1 100644 --- a/Database/Keys.hs +++ b/Database/Keys.hs @@ -29,7 +29,6 @@ import qualified Database.Queue as H import Database.Init import Annex.Locations import Annex.Common hiding (delete) -import Annex.Version (versionUsesKeysDatabase) import qualified Annex import Annex.LockFile import Annex.CatFile @@ -103,10 +102,7 @@ getDbHandle = go =<< Annex.getState Annex.keysdbhandle where go (Just h) = pure h go Nothing = do - h <- ifM versionUsesKeysDatabase - ( liftIO newDbHandle - , liftIO unavailableDbHandle - ) + h <- liftIO newDbHandle Annex.changeState $ \s -> s { Annex.keysdbhandle = Just h } return h @@ -220,7 +216,7 @@ removeInodeCaches = runWriterIO . SQL.removeInodeCaches . toIKey - file. -} reconcileStaged :: H.DbQueue -> Annex () -reconcileStaged qh = whenM versionUsesKeysDatabase $ do +reconcileStaged qh = do gitindex <- inRepo currentIndexFile indexcache <- fromRepo gitAnnexKeysDbIndexCache withTSDelta (liftIO . genInodeCache gitindex) >>= \case diff --git a/Git/Branch.hs b/Git/Branch.hs index 9fc4f0996e..2de6f9e0fd 100644 --- a/Git/Branch.hs +++ b/Git/Branch.hs @@ -15,7 +15,6 @@ import Git.Sha import Git.Command import qualified Git.Config import qualified Git.Ref -import qualified Git.BuildVersion {- The currently checked out branch. - @@ -125,8 +124,7 @@ data CommitMode = ManualCommit | AutomaticCommit {- Prevent signing automatic commits. -} applyCommitMode :: CommitMode -> [CommandParam] -> [CommandParam] applyCommitMode commitmode ps - | commitmode == AutomaticCommit && not (Git.BuildVersion.older "2.0.0") = - Param "--no-gpg-sign" : ps + | commitmode == AutomaticCommit = Param "--no-gpg-sign" : ps | otherwise = ps {- Some versions of git commit-tree honor commit.gpgsign themselves, diff --git a/Git/CheckAttr.hs b/Git/CheckAttr.hs index cfac5b12f0..defa675d46 100644 --- a/Git/CheckAttr.hs +++ b/Git/CheckAttr.hs @@ -10,12 +10,11 @@ module Git.CheckAttr where import Common import Git import Git.Command -import qualified Git.Version import qualified Utility.CoProcess as CoProcess import System.IO.Error -type CheckAttrHandle = (CoProcess.CoProcessHandle, [Attr], Bool, String) +type CheckAttrHandle = (CoProcess.CoProcessHandle, [Attr], String) type Attr = String @@ -25,8 +24,7 @@ checkAttrStart :: [Attr] -> Repo -> IO CheckAttrHandle checkAttrStart attrs repo = do currdir <- getCurrentDirectory h <- gitCoProcessStart True params repo - oldgit <- Git.Version.older "1.7.7" - return (h, attrs, oldgit, currdir) + return (h, attrs, currdir) where params = [ Param "check-attr" @@ -36,12 +34,12 @@ checkAttrStart attrs repo = do [ Param "--" ] checkAttrStop :: CheckAttrHandle -> IO () -checkAttrStop (h, _, _, _) = CoProcess.stop h +checkAttrStop (h, _, _) = CoProcess.stop h {- Gets an attribute of a file. When the attribute is not specified, - returns "" -} checkAttr :: CheckAttrHandle -> Attr -> FilePath -> IO String -checkAttr (h, attrs, oldgit, currdir) want file = do +checkAttr (h, attrs, currdir) want file = do pairs <- CoProcess.query h send (receive "") let vals = map snd $ filter (\(attr, _) -> attr == want) pairs case vals of @@ -78,16 +76,9 @@ checkAttr (h, attrs, oldgit, currdir) want file = do else Nothing -- line incomplete numattrs = length attrs - {- Before git 1.7.7, git check-attr worked best with - - absolute filenames; using them worked around some bugs - - with relative filenames. - - - - With newer git, git check-attr chokes on some absolute - - filenames, and the bugs that necessitated them were fixed, - - so use relative filenames. -} - file' - | oldgit = absPathFrom currdir file - | otherwise = relPathDirToFileAbs currdir $ absPathFrom currdir file + {- git check-attr chokes on some absolute filenames, + - so make sure the filename is relative. -} + file' = relPathDirToFileAbs currdir $ absPathFrom currdir file oldattrvalue attr l = end bits !! 0 where bits = split sep l diff --git a/Git/CheckIgnore.hs b/Git/CheckIgnore.hs index 3ecbd93a65..67eef7abe1 100644 --- a/Git/CheckIgnore.hs +++ b/Git/CheckIgnore.hs @@ -15,7 +15,6 @@ module Git.CheckIgnore ( import Common import Git import Git.Command -import qualified Git.Version import qualified Utility.CoProcess as CoProcess import System.IO.Error @@ -29,17 +28,11 @@ type CheckIgnoreHandle = CoProcess.CoProcessHandle - GIT_FLUSH behavior flushing the output buffer when git check-ignore - is piping to us. - - - The first version of git to support what we need is 1.8.4. - - Nothing is returned if an older git is installed. - - - check-ignore does not support --literal-pathspecs, so remove that - from the gitGlobalOpts if set. -} -checkIgnoreStart :: Repo -> IO (Maybe CheckIgnoreHandle) -checkIgnoreStart repo = ifM supportedGitVersion - ( Just <$> gitCoProcessStart True params repo' - , return Nothing - ) +checkIgnoreStart :: Repo -> IO CheckIgnoreHandle +checkIgnoreStart repo = gitCoProcessStart True params repo' where params = [ Param "check-ignore" @@ -52,11 +45,6 @@ checkIgnoreStart repo = ifM supportedGitVersion pathspecs (Param "--literal-pathspecs") = True pathspecs _ = False -supportedGitVersion :: IO Bool -supportedGitVersion = do - v <- Git.Version.installed - return $ v >= Git.Version.normalize "1.8.4" - {- For some reason, check-ignore --batch always exits nonzero, - so ignore any error. -} checkIgnoreStop :: CheckIgnoreHandle -> IO () diff --git a/Git/Fsck.hs b/Git/Fsck.hs index 9897c54cc2..6f33e11991 100644 --- a/Git/Fsck.hs +++ b/Git/Fsck.hs @@ -22,7 +22,6 @@ import Git import Git.Command import Git.Sha import Utility.Batch -import qualified Git.Version import qualified Data.Set as S import Control.Concurrent.Async @@ -73,9 +72,7 @@ instance Monoid FsckOutput where -} findBroken :: Bool -> Repo -> IO FsckResults findBroken batchmode r = do - supportsNoDangling <- (>= Git.Version.normalize "1.7.10") - <$> Git.Version.installed - let (command, params) = ("git", fsckParams supportsNoDangling r) + let (command, params) = ("git", fsckParams r) (command', params') <- if batchmode then toBatchCommand (command, params) else return (command, params) @@ -86,8 +83,8 @@ findBroken batchmode r = do , std_err = CreatePipe } (o1, o2) <- concurrently - (parseFsckOutput maxobjs r supportsNoDangling (stdoutHandle p)) - (parseFsckOutput maxobjs r supportsNoDangling (stderrHandle p)) + (parseFsckOutput maxobjs r (stdoutHandle p)) + (parseFsckOutput maxobjs r (stderrHandle p)) fsckok <- checkSuccessProcess pid case mappend o1 o2 of FsckOutput badobjs truncated @@ -120,15 +117,15 @@ knownMissing (FsckFoundMissing s _) = s findMissing :: [Sha] -> Repo -> IO MissingObjects findMissing objs r = S.fromList <$> filterM (`isMissing` r) objs -parseFsckOutput :: Int -> Repo -> Bool -> Handle -> IO FsckOutput -parseFsckOutput maxobjs r supportsNoDangling h = do +parseFsckOutput :: Int -> Repo -> Handle -> IO FsckOutput +parseFsckOutput maxobjs r h = do ls <- lines <$> hGetContents h if null ls then return NoFsckOutput else if all ("duplicateEntries" `isInfixOf`) ls then return AllDuplicateEntriesWarning else do - let shas = findShas supportsNoDangling ls + let shas = findShas ls let !truncated = length shas > maxobjs missingobjs <- findMissing (take maxobjs shas) r return $ FsckOutput missingobjs truncated @@ -141,18 +138,14 @@ isMissing s r = either (const True) (const False) <$> tryIO dump , Param (fromRef s) ] r -findShas :: Bool -> [String] -> [Sha] -findShas supportsNoDangling = catMaybes . map extractSha . concat . map words . filter wanted +findShas :: [String] -> [Sha] +findShas = catMaybes . map extractSha . concat . map words . filter wanted where - wanted l - | supportsNoDangling = True - | otherwise = not ("dangling " `isPrefixOf` l) + wanted l = not ("dangling " `isPrefixOf` l) -fsckParams :: Bool -> Repo -> [CommandParam] -fsckParams supportsNoDangling = gitCommandLine $ map Param $ catMaybes - [ Just "fsck" - , if supportsNoDangling - then Just "--no-dangling" - else Nothing - , Just "--no-reflogs" +fsckParams :: Repo -> [CommandParam] +fsckParams = gitCommandLine $ map Param + [ "fsck" + , "--no-dangling" + , "--no-reflogs" ] diff --git a/Git/Index.hs b/Git/Index.hs index 2fdae25b87..a5bd7b9a9c 100644 --- a/Git/Index.hs +++ b/Git/Index.hs @@ -58,19 +58,3 @@ currentIndexFile r = fromMaybe (indexFile r) <$> getEnv indexEnv {- Git locks the index by creating this file. -} indexFileLock :: FilePath -> FilePath indexFileLock f = f ++ ".lock" - -{- When the pre-commit hook is run, and git commit has been run with - - a file or files specified to commit, rather than committing the staged - - index, git provides the pre-commit hook with a "false index file". - - - - Changes made to this index will influence the commit, but won't - - affect the real index file. - - - - This detects when we're in this situation, using a heuristic, which - - might be broken by changes to git. Any use of this should have a test - - case to make sure it works. - -} -haveFalseIndex :: IO Bool -haveFalseIndex = maybe (False) check <$> getEnv indexEnv - where - check f = "next-index" `isPrefixOf` takeFileName f diff --git a/Git/Merge.hs b/Git/Merge.hs index a2c04d7139..510f53b667 100644 --- a/Git/Merge.hs +++ b/Git/Merge.hs @@ -17,7 +17,6 @@ module Git.Merge ( import Common import Git import Git.Command -import qualified Git.BuildVersion import qualified Git.Version import Git.Branch (CommitMode(..)) @@ -33,7 +32,7 @@ merge = merge' [] merge' :: [CommandParam] -> Ref -> [MergeConfig] -> CommitMode -> Repo -> IO Bool merge' extraparams branch mergeconfig commitmode r - | MergeNonInteractive `notElem` mergeconfig || Git.BuildVersion.older "1.7.7.6" = + | MergeNonInteractive `notElem` mergeconfig = go [Param $ fromRef branch] | otherwise = go [Param "--no-edit", Param $ fromRef branch] where diff --git a/Git/Remote/Remove.hs b/Git/Remote/Remove.hs index ae09d8b382..147e59999f 100644 --- a/Git/Remote/Remove.hs +++ b/Git/Remote/Remove.hs @@ -13,17 +13,10 @@ import Common import Git import Git.Types import qualified Git.Command -import qualified Git.Version remove :: RemoteName -> Repo -> IO () -remove remotename r = do - old <- Git.Version.older "1.8.0" - Git.Command.run - [ Param "remote" - -- name of this subcommand changed - , Param $ - if old - then "rm" - else "remove" - , Param remotename - ] r +remove remotename = Git.Command.run + [ Param "remote" + , Param "remove" + , Param remotename + ] diff --git a/Remote/Git.hs b/Remote/Git.hs index dd23fb4452..2b516a9442 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -37,7 +37,6 @@ import Config import Config.Cost import Config.DynamicConfig import Annex.Init -import Annex.Version import Types.CleanupActions import qualified CmdLine.GitAnnexShell.Fields as Fields import Logs.Location @@ -642,7 +641,7 @@ copyToRemote' repo r st@(State connpool duc _ _) key file meterupdate -- This is too broad really, but recvkey normally -- verifies content anyway, so avoid complicating -- it with a local sendAnnex check and rollback. - unlocked <- versionSupportsUnlockedPointers + let unlocked = True oh <- mkOutputHandlerQuiet Ssh.rsyncHelper oh (Just p) =<< Ssh.rsyncParamsRemote unlocked r Upload key object file diff --git a/Test.hs b/Test.hs index d6972e152a..be15365352 100644 --- a/Test.hs +++ b/Test.hs @@ -30,7 +30,6 @@ import CmdLine.GitAnnex.Options import qualified Utility.SafeCommand import qualified Annex -import qualified Annex.Version import qualified Git.Filename import qualified Git.Types import qualified Git.Ref @@ -151,7 +150,6 @@ tests crippledfilesystem adjustedbranchok opts = testmodes = catMaybes [ canadjust ("v7 adjusted unlocked branch", (testMode opts (RepoVersion 7)) { adjustedUnlockedBranch = True }) , unlesscrippled ("v7 unlocked", (testMode opts (RepoVersion 7)) { unlockedFiles = True }) - , unlesscrippled ("v5", testMode opts (RepoVersion 5)) , unlesscrippled ("v7 locked", testMode opts (RepoVersion 7)) ] unlesscrippled v @@ -230,7 +228,7 @@ unitTests note = testGroup ("Unit Tests " ++ note) , testCase "move (ssh remote)" test_move_ssh_remote , testCase "copy" test_copy , testCase "lock" test_lock - , testCase "lock (v7 --force)" test_lock_v7_force + , testCase "lock --force" test_lock_force , testCase "edit (no pre-commit)" test_edit , testCase "edit (pre-commit)" test_edit_precommit , testCase "partial commit" test_partial_commit @@ -584,21 +582,12 @@ test_preferred_content = intmpclonerepo $ do test_lock :: Assertion test_lock = intmpclonerepo $ do annexed_notpresent annexedfile - unlessM (annexeval Annex.Version.versionSupportsUnlockedPointers) $ - ifM (hasUnlockedFiles <$> getTestMode) - ( git_annex_shouldfail "lock" [annexedfile] @? "lock failed to fail with not present file" - , git_annex_shouldfail "unlock" [annexedfile] @? "unlock failed to fail with not present file" - ) - annexed_notpresent annexedfile -- regression test: unlock of newly added, not committed file - -- should fail in v5 mode. In v7 mode, this is allowed. + -- should not fail. writecontent "newfile" "foo" git_annex "add" ["newfile"] @? "add new file failed" - ifM (annexeval Annex.Version.versionSupportsUnlockedPointers) - ( git_annex "unlock" ["newfile"] @? "unlock failed on newly added, never committed file in v7 repository" - , git_annex_shouldfail "unlock" ["newfile"] @? "unlock failed to fail on newly added, never committed file in v5 repository" - ) + git_annex "unlock" ["newfile"] @? "unlock failed on newly added, never committed file" git_annex "get" [annexedfile] @? "get of file failed" annexed_present annexedfile @@ -610,21 +599,15 @@ test_lock = intmpclonerepo $ do writecontent annexedfile $ content annexedfile ++ "foo" git_annex_shouldfail "lock" [annexedfile] @? "lock failed to fail without --force" git_annex "lock" ["--force", annexedfile] @? "lock --force failed" - -- In v7 mode, the original content of the file is not always + -- The original content of an unlocked file is not always -- preserved after modification, so re-get it. git_annex "get" [annexedfile] @? "get of file failed after lock --force" annexed_present_locked annexedfile git_annex "unlock" [annexedfile] @? "unlock failed" unannexed annexedfile changecontent annexedfile - ifM (annexeval Annex.Version.versionSupportsUnlockedPointers) - ( do - boolSystem "git" [Param "add", Param annexedfile] @? "add of modified file failed" - runchecks [checkregularfile, checkwritable] annexedfile - , do - git_annex "add" [annexedfile] @? "add of modified file failed" - runchecks [checklink, checkunwritable] annexedfile - ) + boolSystem "git" [Param "add", Param annexedfile] @? "add of modified file failed" + runchecks [checkregularfile, checkwritable] annexedfile c <- readFile annexedfile assertEqual "content of modified file" c (changedcontent annexedfile) r' <- git_annex "drop" [annexedfile] @@ -633,21 +616,20 @@ test_lock = intmpclonerepo $ do -- Regression test: lock --force when work tree file -- was modified lost the (unmodified) annex object. -- (Only occurred when the keys database was out of sync.) -test_lock_v7_force :: Assertion -test_lock_v7_force = intmpclonerepo $ do +test_lock_force :: Assertion +test_lock_force = intmpclonerepo $ do git_annex "upgrade" [] @? "upgrade failed" - whenM (annexeval Annex.Version.versionSupportsUnlockedPointers) $ do - git_annex "get" [annexedfile] @? "get of file failed" - git_annex "unlock" [annexedfile] @? "unlock failed in v7 mode" - annexeval $ do - Just k <- Annex.WorkTree.lookupFile annexedfile - Database.Keys.removeInodeCaches k - Database.Keys.closeDb - liftIO . nukeFile =<< Annex.fromRepo Annex.Locations.gitAnnexKeysDbIndexCache - writecontent annexedfile "test_lock_v7_force content" - git_annex_shouldfail "lock" [annexedfile] @? "lock of modified file failed to fail in v7 mode" - git_annex "lock" ["--force", annexedfile] @? "lock --force of modified file failed in v7 mode" - annexed_present_locked annexedfile + git_annex "get" [annexedfile] @? "get of file failed" + git_annex "unlock" [annexedfile] @? "unlock failed" + annexeval $ do + Just k <- Annex.WorkTree.lookupFile annexedfile + Database.Keys.removeInodeCaches k + Database.Keys.closeDb + liftIO . nukeFile =<< Annex.fromRepo Annex.Locations.gitAnnexKeysDbIndexCache + writecontent annexedfile "test_lock_force content" + git_annex_shouldfail "lock" [annexedfile] @? "lock of modified file failed to fail" + git_annex "lock" ["--force", annexedfile] @? "lock --force of modified file failed" + annexed_present_locked annexedfile test_edit :: Assertion test_edit = test_edit' False @@ -669,10 +651,7 @@ test_edit' precommit = intmpclonerepo $ do @? "pre-commit failed" else boolSystem "git" [Param "commit", Param "-q", Param "-m", Param "contentchanged"] @? "git commit of edited file failed" - ifM (annexeval Annex.Version.versionSupportsUnlockedPointers) - ( runchecks [checkregularfile, checkwritable] annexedfile - , runchecks [checklink, checkunwritable] annexedfile - ) + runchecks [checkregularfile, checkwritable] annexedfile c <- readFile annexedfile assertEqual "content of modified file" c (changedcontent annexedfile) git_annex_shouldfail "drop" [annexedfile] @? "drop wrongly succeeded with no known copy of modified file" @@ -683,12 +662,8 @@ test_partial_commit = intmpclonerepo $ do annexed_present annexedfile git_annex "unlock" [annexedfile] @? "unlock failed" changecontent annexedfile - ifM (annexeval Annex.Version.versionSupportsUnlockedPointers) - ( boolSystem "git" [Param "commit", Param "-q", Param "-m", Param "test", File annexedfile] - @? "partial commit of unlocked file should be allowed in v7 repository" - , not <$> boolSystem "git" [Param "commit", Param "-q", Param "-m", Param "test", File annexedfile] - @? "partial commit of unlocked file not blocked by pre-commit hook" - ) + boolSystem "git" [Param "commit", Param "-q", Param "-m", Param "test", File annexedfile] + @? "partial commit of unlocked file should be allowed" test_fix :: Assertion test_fix = intmpclonerepo $ unlessM (hasUnlockedFiles <$> getTestMode) $ do @@ -1083,8 +1058,6 @@ test_conflict_resolution_adjusted_branch = writecontent conflictor "conflictor2" add_annex conflictor @? "add conflicter failed" git_annex "sync" [] @? "sync failed in r2" - -- need v7 to use adjust - git_annex "upgrade" [] @? "upgrade failed" -- We might be in an adjusted branch -- already, when eg on a crippled -- filesystem. So, --force it. @@ -1348,19 +1321,19 @@ test_conflict_resolution_symlink_bit = unlessM (hasUnlockedFiles <$> getTestMode all (\i -> Git.Types.toTreeItemType (Git.LsTree.mode i) == Just Git.Types.TreeSymlink) l @? (what ++ " " ++ f ++ " lost symlink bit after merge: " ++ show l) -{- A v7 unlocked file that conflicts with a locked file should be resolved +{- An unlocked file that conflicts with a locked file should be resolved - in favor of the unlocked file, with no variant files, as long as they - both point to the same key. -} test_mixed_lock_conflict_resolution :: Assertion test_mixed_lock_conflict_resolution = withtmpclonerepo $ \r1 -> withtmpclonerepo $ \r2 -> do - indir r1 $ whenM shouldtest $ do + indir r1 $ do disconnectOrigin writecontent conflictor "conflictor" git_annex "add" [conflictor] @? "add conflicter failed" git_annex "sync" [] @? "sync failed in r1" - indir r2 $ whenM shouldtest $ do + indir r2 $ do disconnectOrigin writecontent conflictor "conflictor" git_annex "add" [conflictor] @? "add conflicter failed" @@ -1372,10 +1345,9 @@ test_mixed_lock_conflict_resolution = checkmerge "r1" r1 checkmerge "r2" r2 where - shouldtest = annexeval Annex.Version.versionSupportsUnlockedPointers conflictor = "conflictor" variantprefix = conflictor ++ ".variant" - checkmerge what d = indir d $ whenM shouldtest $ do + checkmerge what d = indir d $ do l <- getDirectoryContents "." let v = filter (variantprefix `isPrefixOf`) l length v == 0 diff --git a/Test/Framework.hs b/Test/Framework.hs index 1c3ffccfc5..000d80e528 100644 --- a/Test/Framework.hs +++ b/Test/Framework.hs @@ -150,7 +150,7 @@ indir dir a = do Left e -> throwM e adjustedbranchsupported :: FilePath -> IO Bool -adjustedbranchsupported repo = indir repo $ annexeval Annex.AdjustedBranch.isSupported +adjustedbranchsupported repo = indir repo $ Annex.AdjustedBranch.isGitVersionSupported setuprepo :: FilePath -> IO FilePath setuprepo dir = do diff --git a/Types/GitConfig.hs b/Types/GitConfig.hs index 7976f08e9f..9e37bc1f3a 100644 --- a/Types/GitConfig.hs +++ b/Types/GitConfig.hs @@ -103,6 +103,7 @@ data GitConfig = GitConfig , annexMaxExtensionLength :: Maybe Int , annexJobs :: Concurrency , annexCacheCreds :: Bool + , annexAutoUpgradeRepository :: Bool , coreSymlinks :: Bool , coreSharedRepository :: SharedRepository , receiveDenyCurrentBranch :: DenyCurrentBranch @@ -182,6 +183,7 @@ extractGitConfig r = GitConfig , annexJobs = fromMaybe NonConcurrent $ parseConcurrency =<< getmaybe (annex "jobs") , annexCacheCreds = getbool (annex "cachecreds") True + , annexAutoUpgradeRepository = getbool (annex "autoupgraderepository") True , coreSymlinks = getbool "core.symlinks" True , coreSharedRepository = getSharedRepository r , receiveDenyCurrentBranch = getDenyCurrentBranch r diff --git a/Upgrade.hs b/Upgrade.hs index 353572574a..1cde059521 100644 --- a/Upgrade.hs +++ b/Upgrade.hs @@ -1,6 +1,6 @@ {- git-annex upgrade support - - - Copyright 2010, 2013 Joey Hess + - Copyright 2010-2019 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -10,6 +10,8 @@ module Upgrade where import Annex.Common +import qualified Annex +import qualified Git import Annex.Version import Types.RepoVersion #ifndef mingw32_HOST_OS @@ -36,14 +38,23 @@ needsUpgrade v err "Upgrade this repository: git-annex upgrade" | otherwise -> err "Upgrade git-annex." - Just newv -> ifM (upgrade True newv) - ( ok - , err "Automatic upgrade failed!" + Just newv -> ifM (annexAutoUpgradeRepository <$> Annex.getGitConfig) + ( tryNonAsync (upgrade True newv) >>= \case + Right True -> ok + Right False -> err "Automatic upgrade failed!" + Left ex -> err $ "Automatic upgrade exception! " ++ show ex + , err "Automatic upgrade is disabled by annex.autoupgraderepository configuration. To upgrade this repository: git-annex upgrade" ) where - err msg = return $ Just $ "Repository version " ++ - show (fromRepoVersion v) ++ - " is not supported. " ++ msg + err msg = do + g <- Annex.gitRepo + p <- liftIO $ absPath $ Git.repoPath g + return $ Just $ unwords + [ "Repository", p + , "is at unsupported version" + , show (fromRepoVersion v) ++ "." + , msg + ] ok = return Nothing upgrade :: Bool -> RepoVersion -> Annex Bool @@ -74,3 +85,4 @@ upgrade automatic destversion = do up (RepoVersion 5) = Upgrade.V5.upgrade automatic up (RepoVersion 6) = Upgrade.V6.upgrade automatic up _ = return True + diff --git a/Utility/CopyFile.hs b/Utility/CopyFile.hs index 971fb5b07c..e3cdc46b58 100644 --- a/Utility/CopyFile.hs +++ b/Utility/CopyFile.hs @@ -35,7 +35,8 @@ copyMetaDataParams meta = map snd $ filter fst allmeta = meta == CopyAllMetaData {- The cp command is used, because I hate reinventing the wheel, - - and because this allows easy access to features like cp --reflink. -} + - and because this allows easy access to features like cp --reflink + - and preserving metadata. -} copyFileExternal :: CopyMetaData -> FilePath -> FilePath -> IO Bool copyFileExternal meta src dest = do -- Delete any existing dest file because an unwritable file diff --git a/debian/control b/debian/control index 6b2e3cb405..f1808631f7 100644 --- a/debian/control +++ b/debian/control @@ -81,7 +81,7 @@ Build-Depends: lsof [linux-any], ikiwiki, libimage-magick-perl, - git (>= 1:1.8.1), + git (>= 1:2.1), rsync, curl, openssh-client, diff --git a/doc/bugs/Hard_links_not_synced_in_direct_mode.mdwn b/doc/bugs/Hard_links_not_synced_in_direct_mode.mdwn index 6ede618605..03827d4647 100644 --- a/doc/bugs/Hard_links_not_synced_in_direct_mode.mdwn +++ b/doc/bugs/Hard_links_not_synced_in_direct_mode.mdwn @@ -126,3 +126,5 @@ Codename: precise > [[!taglink confirmed]] (but may be out of scope for git-annex) --[[Joey]] + +[[!meta title="assistant does not notice all changes to hard linked files"]] diff --git a/doc/bugs/Hard_links_not_synced_in_direct_mode/comment_6_12379a8e89ce8505123f5b24f3dbbaca._comment b/doc/bugs/Hard_links_not_synced_in_direct_mode/comment_6_12379a8e89ce8505123f5b24f3dbbaca._comment new file mode 100644 index 0000000000..1164b6066a --- /dev/null +++ b/doc/bugs/Hard_links_not_synced_in_direct_mode/comment_6_12379a8e89ce8505123f5b24f3dbbaca._comment @@ -0,0 +1,8 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 6""" + date="2019-09-11T17:24:38Z" + content=""" +This bug is not specific to direct mode; in v7 adjusted unlocked branch +the assistant behaves the same as it did in my last comment above. +"""]] diff --git a/doc/bugs/__34__Adding_4923_files__34___is_really_slow.mdwn b/doc/bugs/__34__Adding_4923_files__34___is_really_slow.mdwn index 6a0b5ced9f..efdf1114b7 100644 --- a/doc/bugs/__34__Adding_4923_files__34___is_really_slow.mdwn +++ b/doc/bugs/__34__Adding_4923_files__34___is_really_slow.mdwn @@ -101,3 +101,7 @@ add music/Pop/Various/Like, Omigod! The 80s Pop Culture Box (totally)/._4-08 Tal [[!tag confirmed]] [[!meta tag=deprecateddirectmode]] + +> direct mode has been removed from git-annex, and its replacement, v7 +> unlocked files, uses sqlite and should not suffer from a slowdown when +> many work tree files have the same content. So [[done]] --[[Joey]] diff --git a/doc/bugs/crippled_filesystem_direct_mode_sync_loop.mdwn b/doc/bugs/crippled_filesystem_direct_mode_sync_loop.mdwn index d7db94c8cb..2ace44e295 100644 --- a/doc/bugs/crippled_filesystem_direct_mode_sync_loop.mdwn +++ b/doc/bugs/crippled_filesystem_direct_mode_sync_loop.mdwn @@ -72,3 +72,5 @@ git log | grep refs/heads/synced/master | wc ### 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) I'm new to git-annex and immediately astonished by its unique strength. I fit the Archivist use case, and this could be the solution I wanted for so long. I'm planning to deploy it on 2 Windows boxes and several USB disks, all of them on NTFS. I learnt the idea that v6 repo is not yet good for Win/NTFS (double disk space), so I guess direct mode is the way to go? I have already got some test repos running and practicing, indeed this sync loop problem is the only remaining case I'm not confident with. Is it a bug or some safety measure feature? Am I good to go? Thanks and oh, Merry X'mas! + +> [[done]] --[[Joey]] diff --git a/doc/bugs/crippled_filesystem_direct_mode_sync_loop/comment_2_81050b1206f47fa275627cc22b144086._comment b/doc/bugs/crippled_filesystem_direct_mode_sync_loop/comment_2_81050b1206f47fa275627cc22b144086._comment new file mode 100644 index 0000000000..75bd327a0d --- /dev/null +++ b/doc/bugs/crippled_filesystem_direct_mode_sync_loop/comment_2_81050b1206f47fa275627cc22b144086._comment @@ -0,0 +1,15 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 2""" + date="2019-09-11T17:30:11Z" + content=""" +I have also seen sync loops in direct mode repos not on NTFS. + +git-annex has not supported direct mode on NTFS since earlier this year, +and now direct mode support has been removed entirely, replaced with v7 +adjusted unlocked branches. I tried replicating this bug on NTFS using +those, and the syncs quieted down immediately after changes stopped being +made. + +So, closing this bug. +"""]] diff --git a/doc/bugs/direct_command_leaves_repository_inconsistent_if_interrupted.mdwn b/doc/bugs/direct_command_leaves_repository_inconsistent_if_interrupted.mdwn index 8a88811730..1afed590ed 100644 --- a/doc/bugs/direct_command_leaves_repository_inconsistent_if_interrupted.mdwn +++ b/doc/bugs/direct_command_leaves_repository_inconsistent_if_interrupted.mdwn @@ -45,3 +45,5 @@ Similar issues and discussions: [[!meta title="git annex lock --force deletes only copy of content after interrupted switch to direct mode"] [[!meta tag=deprecateddirectmode]] + +> direct mode has been removed from git-annex, so [[done]] --[[Joey]] diff --git a/doc/bugs/direct_mode_fails__44___left_in_an_inconsistent_state.mdwn b/doc/bugs/direct_mode_fails__44___left_in_an_inconsistent_state.mdwn index 42746b9665..98440ef13f 100644 --- a/doc/bugs/direct_mode_fails__44___left_in_an_inconsistent_state.mdwn +++ b/doc/bugs/direct_mode_fails__44___left_in_an_inconsistent_state.mdwn @@ -59,3 +59,6 @@ git-annex: direct: 1 failed [[!tag moreinfo]] [[!meta tag=deprecateddirectmode]] + +> direct mode has been removed from git-annex, so closing this old bug +> [[done]] --[[Joey]] diff --git a/doc/bugs/direct_mode_merge_interrupt.mdwn b/doc/bugs/direct_mode_merge_interrupt.mdwn index f6bb795b6d..500325951d 100644 --- a/doc/bugs/direct_mode_merge_interrupt.mdwn +++ b/doc/bugs/direct_mode_merge_interrupt.mdwn @@ -54,3 +54,5 @@ merge. (I assume this is how `git merge` normally works.) --[[Joey]] > quickly.. --[[Joey]] [[!meta tag=deprecateddirectmode]] + +> direct mode has been removed. [[done]] --[[Joey]] diff --git a/doc/bugs/direct_mode_should_refuse_to_merge_with_illegal_filenames.mdwn b/doc/bugs/direct_mode_should_refuse_to_merge_with_illegal_filenames.mdwn index f90710277b..7db4e2b441 100644 --- a/doc/bugs/direct_mode_should_refuse_to_merge_with_illegal_filenames.mdwn +++ b/doc/bugs/direct_mode_should_refuse_to_merge_with_illegal_filenames.mdwn @@ -36,3 +36,5 @@ Alternatively, git-annex could learn/probe the full set of characters not allowe [[!tag confirmed]] [[!meta tag=deprecateddirectmode]] + +> direct mode has been removed. [[done]] --[[Joey]] diff --git a/doc/bugs/git_annex_status_fails_with_submodule_in_direct_mode.mdwn b/doc/bugs/git_annex_status_fails_with_submodule_in_direct_mode.mdwn index eafd22e0b9..cc91f24351 100644 --- a/doc/bugs/git_annex_status_fails_with_submodule_in_direct_mode.mdwn +++ b/doc/bugs/git_annex_status_fails_with_submodule_in_direct_mode.mdwn @@ -55,3 +55,5 @@ operating system: linux x86_64 ### 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) Yes! I think it's a great piece of software! + +> direct mode has been removed from git-annex, so [[done]] --[[Joey]] diff --git a/doc/bugs/git_annex_sync_in_direct_mode_does_not_honor_skip-worktree.mdwn b/doc/bugs/git_annex_sync_in_direct_mode_does_not_honor_skip-worktree.mdwn index 7ff82b69d3..89f6bac1f9 100644 --- a/doc/bugs/git_annex_sync_in_direct_mode_does_not_honor_skip-worktree.mdwn +++ b/doc/bugs/git_annex_sync_in_direct_mode_does_not_honor_skip-worktree.mdwn @@ -36,3 +36,5 @@ I wonder if this would have side effects, or if there are other places in the co [[!tag confirmed]] [[!meta tag=deprecateddirectmode]] + +> direct mode has been removed from git-annex, so [[done]] --[[Joey]] diff --git a/doc/git-annex-add.mdwn b/doc/git-annex-add.mdwn index 70d3236e9f..d3d4c36247 100644 --- a/doc/git-annex-add.mdwn +++ b/doc/git-annex-add.mdwn @@ -23,8 +23,7 @@ Large files are added to the annex in locked form, which prevents further modification of their content unless unlocked by [[git-annex-unlock]](1). (This is not the case however when a repository is in a filesystem not supporting symlinks.) -To add a file to the annex in unlocked form, `git add` can be used instead -(that only works in repository v7 or higher). +To add a file to the annex in unlocked form, `git add` can be used instead. This command can also be used to add symbolic links, both symlinks to annexed content, and other symlinks. diff --git a/doc/git-annex-adjust.mdwn b/doc/git-annex-adjust.mdwn index c03a6e43b4..1b6a93f997 100644 --- a/doc/git-annex-adjust.mdwn +++ b/doc/git-annex-adjust.mdwn @@ -34,8 +34,6 @@ while inside the adjusted branch will update the adjusted branch as necessary (eg for `--hide-missing`), and will also propagate commits back to the original branch. -This command can only be used in a v7 git-annex repository. - # OPTIONS * `--unlock` diff --git a/doc/git-annex-post-receive.mdwn b/doc/git-annex-post-receive.mdwn index 6d71681caf..a5f4e6c08d 100644 --- a/doc/git-annex-post-receive.mdwn +++ b/doc/git-annex-post-receive.mdwn @@ -13,7 +13,7 @@ automatically creates a post-receive hook using this. When a repository is configured with receive.denyCurrentBranch=updateInstead, pushes to the repository update its work tree. However, that does not work -for repositories that use have an adjusted branch checked +for repositories that have an adjusted branch checked out. The hook updates the work tree when run in such a repository, the same as running `git-annex merge` would. diff --git a/doc/git-annex-pre-commit.mdwn b/doc/git-annex-pre-commit.mdwn index a08845bbb0..0759e0df24 100644 --- a/doc/git-annex-pre-commit.mdwn +++ b/doc/git-annex-pre-commit.mdwn @@ -17,9 +17,6 @@ point to annexed content. When in a view, updates metadata to reflect changes made to files in the view. -When in a repository that has not been upgraded to v7, -also handles injecting changes to unlocked files into the annex. - # SEE ALSO [[git-annex]](1) diff --git a/doc/git-annex-unlock.mdwn b/doc/git-annex-unlock.mdwn index 9e93fc7287..32580ec6c5 100644 --- a/doc/git-annex-unlock.mdwn +++ b/doc/git-annex-unlock.mdwn @@ -14,21 +14,21 @@ symlink for each specified file with the file's content. You can then modify it and `git annex add` (or `git commit`) to save your changes. -In v5 repositories, unlocking a file is local -to the repository, and is temporary. In v7 repositories, unlocking a file -changes how it is stored in the git repository (from a symlink to a pointer -file), so you can commit it like any other change. Also in v7, you -can use `git add` to add a file to the annex in unlocked form. This allows -workflows where a file starts out unlocked, is modified as necessary, and -is locked once it reaches its final version. +Unlocking a file changes how it is stored in the git repository (from a +symlink to a pointer file), so this command will make a change that you +can commit. -Normally, unlocking a file requires a copy to be made of its content, -so that its original content is preserved, while the copy can be modified. -To use less space, annex.thin can be set to true; this makes a hard link -to the content be made instead of a copy. (Only when supported by the file -system, and only in v7 and higher.) While this can save considerable -disk space, any modification made to a file will cause the old version of the -file to be lost from the local repository. So, enable annex.thin with care. +If you use `git add` to add a file, it will be added in unlocked form from +the beginning. This allows workflows where a file starts out unlocked, is +modified as necessary, and is locked once it reaches its final version. + +Normally, unlocking a file requires a copy to be made of its content, so +that its original content is preserved, while the copy can be modified. To +use less space, annex.thin can be set to true; this makes a hard link to +the content be made instead of a copy. (Only when supported by the file +system.) While this can save considerable disk space, any modification made +to a file will cause the old version of the file to be lost from the local +repository. So, enable annex.thin with care. # OPTIONS diff --git a/doc/git-annex-upgrade.mdwn b/doc/git-annex-upgrade.mdwn index 07b319cc11..c27fedd642 100644 --- a/doc/git-annex-upgrade.mdwn +++ b/doc/git-annex-upgrade.mdwn @@ -1,6 +1,6 @@ # NAME -git-annex upgrade - upgrade repository layout +git-annex upgrade - upgrade repository # SYNOPSIS @@ -8,13 +8,16 @@ git annex upgrade # DESCRIPTION -Upgrades the repository to current layout. +Upgrades the repository. Each git-annex repository has an annex.version in its git configuration, -that indicates the repository version. If git-annex changes to a new -layout, you must upgrade the repository before git-annex can be used in it. +that indicates the repository version. When an old repository version +becomes deprecated, git-annex will automatically upgrade it +(unless annex.autoupgraderepository is set to false). To manually upgrade, +you can use this command. -To see version information, run `git annex version`. +Sometimes there's a newer repository version that is not the default yet, +and then you can use this command to upgrade to it. Currently, git-annex supports upgrades all the way back to version 0, which was only used by its author. It's expected that git-annex will always diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 5aae0e2de5..121e0d9477 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -383,7 +383,7 @@ subdirectories). * `upgrade` - Upgrades the repository to current layout. + Upgrades the repository. See [[git-annex-upgrade]](1) for details. @@ -836,10 +836,9 @@ may not be explicitly listed on their individual man pages. Overrides git configuration settings. May be specified multiple times. -# CONFIGURATION VIA .git/config +# CONFIGURATION Like other git commands, git-annex is configured via `.git/config`. -Here are all the supported configuration settings. * `annex.uuid` @@ -908,7 +907,7 @@ Here are all the supported configuration settings. Set to true to make commands like `git-annex add` that add files to the repository add them in unlocked form. The default is to add files in - locked form. This only has effect in v7 repositories. + locked form. When a repository has core.symlinks set to false, it implicitly sets annex.addunlocked to true. @@ -1044,55 +1043,6 @@ Here are all the supported configuration settings. And when multiple files in the work tree have the same content, only one of them gets hard linked to the annex. -* `annex.delayadd` - - Makes the watch and assistant commands delay for the specified number of - seconds before adding a newly created file to the annex. Normally this - is not needed, because they already wait for all writers of the file - to close it. On Mac OSX, this defaults to - 1 second, to work around a bad interaction with software there. - -* `annex.expireunused` - - Controls what the assistant does about unused file contents - that are stored in the repository. - - The default is `false`, which causes - all old and unused file contents to be retained, unless the assistant - is able to move them to some other repository (such as a backup repository). - - Can be set to a time specification, like "7d" or "1m", and then - file contents that have been known to be unused for a week or a - month will be deleted. - -* `annex.fscknudge` - - When set to false, prevents the webapp from reminding you when using - repositories that lack consistency checks. - -* `annex.autoupgrade` - - When set to ask (the default), the webapp will check for new versions - and prompt if they should be upgraded to. When set to true, automatically - upgrades without prompting (on some supported platforms). When set to - false, disables any upgrade checking. - - Note that upgrade checking is only done when git-annex is installed - from one of the prebuilt images from its website. This does not - bypass e.g., a Linux distribution's own upgrade handling code. - - This setting also controls whether to restart the git-annex assistant - when the git-annex binary is detected to have changed. That is useful - no matter how you installed git-annex. - -* `annex.autocommit` - - Set to false to prevent the git-annex assistant and git-annex sync - from automatically committing changes to files in the repository. - - To configure the behavior in all clones of the repository, - this can be set in [[git-annex-config]]. - * `annex.resolvemerge` Set to false to prevent merge conflicts in the checked out branch @@ -1110,26 +1060,25 @@ Here are all the supported configuration settings. To configure the behavior in all clones of the repository, this can be set in [[git-annex-config]]. -* `annex.startupscan` - - Set to false to prevent the git-annex assistant from scanning the - repository for new and changed files on startup. This will prevent it - from noticing changes that were made while it was not running, but can be - a useful performance tweak for a large repository. - -* `annex.listen` - - Configures which address the webapp listens on. The default is localhost. - Can be either an IP address, or a hostname that resolves to the desired - address. - * `annex.debug` Set to true to enable debug logging by default. * `annex.version` - Automatically maintained, and used to automate upgrades between versions. + The current version of the git-annex repository. This is + maintained by git-annex and should never be manually changed. + +* `annex.autoupgraderepository` + + When an old git-annex repository version has become deprecated, + git-annex will normally automatically upgrade the repository to + the new version. + + If this is set to false, git-annex won't automatically upgrade the + repository. Instead it will exit with an error message. You can run + `git annex upgrade` yourself when you are ready to upgrade the + repository. * `annex.crippledfilesystem` @@ -1173,6 +1122,27 @@ Here are all the supported configuration settings. be extracted and decrypted each time git-annex needs to access the remote. +* `annex.secure-erase-command` + + This can be set to a command that should be run whenever git-annex + removes the content of a file from the repository. + + In the command line, %file is replaced with the file that should be + erased. + + For example, to use the wipe command, set it to `wipe -f %file`. + +* `annex.tune.objecthash1`, `annex.tune.objecthashlower`, `annex.tune.branchhash1` + + These can be passed to `git annex init` to tune the repository. + They cannot be safely changed in a running repository and should never be + set in global git configuration. + For details, see . + +# CONFIGURATION OF REMOTES + +Remotes are configured using these settings in `.git/config`. + * `remote..annex-cost` When determining which repository to @@ -1408,6 +1378,91 @@ Here are all the supported configuration settings. Default options to use if a remote does not have more specific options as described above. +* `remote..annex-rsyncurl` + + Used by rsync special remotes, this configures + the location of the rsync repository to use. Normally this is automatically + set up by `git annex initremote`, but you can change it if needed. + +* `remote..annex-buprepo` + + Used by bup special remotes, this configures + the location of the bup repository to use. Normally this is automatically + set up by `git annex initremote`, but you can change it if needed. + +* `remote..annex-ddarrepo` + + Used by ddar special remotes, this configures + the location of the ddar repository to use. Normally this is automatically + set up by `git annex initremote`, but you can change it if needed. + +* `remote..annex-directory` + + Used by directory special remotes, this configures + the location of the directory where annexed files are stored for this + remote. Normally this is automatically set up by `git annex initremote`, + but you can change it if needed. + +* `remote..annex-adb` + + Used to identify remotes on Android devices accessed via adb. + Normally this is automatically set up by `git annex initremote`. + +* `remote..annex-androiddirectory` + + Used by adb special remotes, this is the directory on the Android + device where files are stored for this remote. Normally this is + automatically set up by `git annex initremote`, but you can change + it if needed. + +* `remote..annex-androidserial` + + Used by adb special remotes, this is the serial number of the Android + device used by the remote. Normally this is automatically set up by + `git annex initremote`, but you can change it if needed, eg when + upgrading to a new Android device. + +* `remote..annex-s3` + + Used to identify Amazon S3 special remotes. + Normally this is automatically set up by `git annex initremote`. + +* `remote..annex-glacier` + + Used to identify Amazon Glacier special remotes. + Normally this is automatically set up by `git annex initremote`. + +* `remote..annex-webdav` + + Used to identify webdav special remotes. + Normally this is automatically set up by `git annex initremote`. + +* `remote..annex-tahoe` + + Used to identify tahoe special remotes. + Points to the configuration directory for tahoe. + +* `remote..annex-gcrypt` + + Used to identify gcrypt special remotes. + Normally this is automatically set up by `git annex initremote`. + + It is set to "true" if this is a gcrypt remote. + If the gcrypt remote is accessible over ssh and has git-annex-shell + available to manage it, it's set to "shell". + +* `remote..annex-git-lfs` + + Used to identify git-lfs special remotes. + Normally this is automatically set up by `git annex initremote`. + + It is set to "true" if this is a git-lfs remote. + +* `remote..annex-hooktype`, `remote..annex-externaltype` + + Used by hook special remotes and external special remotes to record + the type of the remote. + * `annex.web-options` Options to pass to curl when git-annex uses it to download urls @@ -1523,111 +1578,72 @@ Here are all the supported configuration settings. It would be a good idea to check that it downloaded the file you expected, too. -* `remote.name.annex-security-allow-unverified-downloads` +* `remote..annex-security-allow-unverified-downloads` Per-remote configuration of annex.security.allow-unverified-downloads. -* `annex.secure-erase-command` +# CONFIGURATION OF ASSISTANT - This can be set to a command that should be run whenever git-annex - removes the content of a file from the repository. +* `annex.delayadd` - In the command line, %file is replaced with the file that should be - erased. + Makes the watch and assistant commands delay for the specified number of + seconds before adding a newly created file to the annex. Normally this + is not needed, because they already wait for all writers of the file + to close it. - For example, to use the wipe command, set it to `wipe -f %file`. +* `annex.expireunused` -* `remote..annex-rsyncurl` + Controls what the assistant does about unused file contents + that are stored in the repository. - Used by rsync special remotes, this configures - the location of the rsync repository to use. Normally this is automatically - set up by `git annex initremote`, but you can change it if needed. + The default is `false`, which causes + all old and unused file contents to be retained, unless the assistant + is able to move them to some other repository (such as a backup repository). -* `remote..annex-buprepo` + Can be set to a time specification, like "7d" or "1m", and then + file contents that have been known to be unused for a week or a + month will be deleted. - Used by bup special remotes, this configures - the location of the bup repository to use. Normally this is automatically - set up by `git annex initremote`, but you can change it if needed. +* `annex.fscknudge` -* `remote..annex-ddarrepo` + When set to false, prevents the webapp from reminding you when using + repositories that lack consistency checks. - Used by ddar special remotes, this configures - the location of the ddar repository to use. Normally this is automatically - set up by `git annex initremote`, but you can change it if needed. +* `annex.autoupgrade` -* `remote..annex-directory` + When set to ask (the default), the webapp will check for new versions + and prompt if they should be upgraded to. When set to true, automatically + upgrades without prompting (on some supported platforms). When set to + false, disables any upgrade checking. - Used by directory special remotes, this configures - the location of the directory where annexed files are stored for this - remote. Normally this is automatically set up by `git annex initremote`, - but you can change it if needed. + Note that upgrade checking is only done when git-annex is installed + from one of the prebuilt images from its website. This does not + bypass e.g., a Linux distribution's own upgrade handling code. -* `remote..annex-adb` + This setting also controls whether to restart the git-annex assistant + when the git-annex binary is detected to have changed. That is useful + no matter how you installed git-annex. - Used to identify remotes on Android devices accessed via adb. - Normally this is automatically set up by `git annex initremote`. +* `annex.autocommit` -* `remote..annex-androiddirectory` + Set to false to prevent the git-annex assistant and git-annex sync + from automatically committing changes to files in the repository. - Used by adb special remotes, this is the directory on the Android - device where files are stored for this remote. Normally this is - automatically set up by `git annex initremote`, but you can change - it if needed. + To configure the behavior in all clones of the repository, + this can be set in [[git-annex-config]]. -* `remote..annex-androidserial` +* `annex.startupscan` - Used by adb special remotes, this is the serial number of the Android - device used by the remote. Normally this is automatically set up by - `git annex initremote`, but you can change it if needed, eg when - upgrading to a new Android device. + Set to false to prevent the git-annex assistant from scanning the + repository for new and changed files on startup. This will prevent it + from noticing changes that were made while it was not running, but can be + a useful performance tweak for a large repository. -* `remote..annex-s3` +* `annex.listen` - Used to identify Amazon S3 special remotes. - Normally this is automatically set up by `git annex initremote`. - -* `remote..annex-glacier` - - Used to identify Amazon Glacier special remotes. - Normally this is automatically set up by `git annex initremote`. - -* `remote..annex-webdav` - - Used to identify webdav special remotes. - Normally this is automatically set up by `git annex initremote`. - -* `remote..annex-tahoe` - - Used to identify tahoe special remotes. - Points to the configuration directory for tahoe. - -* `remote..annex-gcrypt` - - Used to identify gcrypt special remotes. - Normally this is automatically set up by `git annex initremote`. - - It is set to "true" if this is a gcrypt remote. - If the gcrypt remote is accessible over ssh and has git-annex-shell - available to manage it, it's set to "shell". - -* `remote..annex-git-lfs` - - Used to identify git-lfs special remotes. - Normally this is automatically set up by `git annex initremote`. - - It is set to "true" if this is a git-lfs remote. - -* `remote..annex-hooktype`, `remote..annex-externaltype` - - Used by hook special remotes and external special remotes to record - the type of the remote. - -* `annex.tune.objecthash1`, `annex.tune.objecthashlower`, `annex.tune.branchhash1` - - These can be passed to `git annex init` to tune the repository. - They cannot be safely changed in a running repository and should never be - set in global git configuration. - For details, see . + Configures which address the webapp listens on. The default is localhost. + Can be either an IP address, or a hostname that resolves to the desired + address. # CONFIGURATION VIA .gitattributes diff --git a/doc/install.mdwn b/doc/install.mdwn index f9f9c9afb1..1d2c246666 100644 --- a/doc/install.mdwn +++ b/doc/install.mdwn @@ -15,7 +15,7 @@ detailed instructions | quick install   [[Gentoo]] | `emerge git-annex`   [[Guix]] | `guix package -i git-annex`   [[Void]] | `xbps-install git-annex` -  [[ScientificLinux5]] | +  [[ScientificLinux]] |   [[openSUSE]] | `zypper in git-annex`   [[Docker]] |   [[conda]] | `conda install -c conda-forge git-annex` diff --git a/doc/install/ScientificLinux.mdwn b/doc/install/ScientificLinux.mdwn new file mode 100644 index 0000000000..116d1c0a14 --- /dev/null +++ b/doc/install/ScientificLinux.mdwn @@ -0,0 +1,5 @@ +Install the [EPEL](https://fedoraproject.org/wiki/EPEL) +repo and yum install git-annex. + +However, the git-annex in EPEL is very old (from 2014 in EPEL 7). +Use the [[Linux_standalone]] install to get a current version. diff --git a/doc/install/ScientificLinux5.mdwn b/doc/install/ScientificLinux5.mdwn deleted file mode 100644 index 442fcb3bfe..0000000000 --- a/doc/install/ScientificLinux5.mdwn +++ /dev/null @@ -1,37 +0,0 @@ -For SL6/CentOS6 install the EPEL repo and yum install git-annex. - -I was waiting for my backups to be done hence this article, as I was using -_git-annex_ to manage my files and I decided I needed to have -git-annex on a SL5 based machine. SL5 is just an opensource -clone/recompile of RHEL5. - -I haven't tried to install the newer versions of Haskell Platform and -GHC in a while on SL5 to install git-annex. But the last time I checked -when GHC7 was out, it was a pain to install GHC on SL5. - -However I have discovered that someone has gone through the trouble of -packaging up GHC and Haskell Platform for RHEL based distros. - -* - Packaged GHC and Haskell Platform - RPM's for RHEL based systems. - -I'm primarily interested in installing _git-annex_ on SL5 based -systems. The installation process goes as such... - -First install GHC and Haskell Platform (you need root for these -following steps) - - $ wget http://sherkin.justhub.org/el5/RPMS/x86_64/justhub-release-2.0-4.0.el5.x86_64.rpm - $ rpm -ivh justhub-release-2.0-4.0.el5.x86_64.rpm - $ yum install haskell - -The RPM's don't place the files in /usr/bin, so you must add the -following to your .bashrc (from here on you don't need root if you -don't want things to be system wide) - - $ export PATH=/usr/hs/bin:$PATH - -Once the GHC packages are installed and are in your execution path, using -cabal to build git-annex just makes life easier, it -should install all the needed dependancies. See "minimal build with cabal -and stackage" in [[fromsource]] for instructions. diff --git a/doc/tips/unlocked_files.mdwn b/doc/tips/unlocked_files.mdwn index 63761357e5..ab4d5e4387 100644 --- a/doc/tips/unlocked_files.mdwn +++ b/doc/tips/unlocked_files.mdwn @@ -9,50 +9,15 @@ want to lose it in a fumblefingered mistake. bash: some_file: Permission denied Sometimes though you want to modify a file. Maybe once, or maybe -repeatedly. To modify a locked file, you have to first unlock it, -by running `git annex unlock`. +repeatedly. To support this, git-annex also supports unlocked files. +They are stored in the git repository differently, and they appear as +regular files in the working tree, instead of the symbolic links used for +locked files. - # git annex unlock some_file - # echo "new content" > some_file +## adding unlocked files -Back before git-annex version 7, and its v7 repository mode, unlocking a file -like this was a transient thing. You'd modify it and then `git annex add` the -modified version to the annex, and finally `git commit`. The new version of -the file was then back to being locked. - - # git annex add some_file - add some_file - # git commit - -But, that had some problems. The main one is that some users want to be able -to edit files repeatedly, without manually having to unlock them every time. -The [[direct_mode]] made all files be unlocked all the time, but it -had many problems of its own. - -## enter v7 mode - -This led to the v7 repository mode, which makes unlocked files remain -unlocked after they're committed, so you can keep changing them and -committing the changes whenever you'd like. It also lets you use more -normal git commands (or even interfaces on top of git) for handling -annexed files. - -To get a repository into v7 mode, you can [[upgrade|upgrades]] it. -This will eventually happen automatically, but for now it's a manual process -(be sure to read [[upgrades]] before doing this): - - # git annex upgrade - -Or, you can init a new repository in v7 mode. - - # git init - # git annex init --version=7 - -## using it - -Using a v7 repository is easy! Simply use regular git commands to add -and commit files. In a git-annex repository, git will use git-annex -to store the file contents, and the files will be left unlocked. +Instead of using `git annex add`, use `git add`, and the file will be +stored in git-annex, but left unlocked. [[!template id=note text=""" Want `git add` to add some file contents to the annex, but store the contents of @@ -94,7 +59,7 @@ mode is used. To make them always use unlocked mode, run: ## mixing locked and unlocked files -A v7 repository can contain both locked and unlocked files. You can switch +A repository can contain both locked and unlocked files. You can switch a file back and forth using the `git annex lock` and `git annex unlock` commands. This changes what's stored in git between a git-annex symlink (locked) and a git-annex pointer file (unlocked). To add a file to @@ -110,7 +75,7 @@ automatically sets up a repository to use all unlocked files. ## imperfections -Unlocked files in v7 repositories mostly work very well, but there are a +Unlocked files mostly work very well, but there are a few imperfections which you should be aware of when using them. 1. `git stash`, `git cherry-pick` and `git reset --hard` don't update diff --git a/doc/todo/cloning_direct_mode_repo_over_http.mdwn b/doc/todo/cloning_direct_mode_repo_over_http.mdwn index 8f471f6e47..b5d037e86e 100644 --- a/doc/todo/cloning_direct_mode_repo_over_http.mdwn +++ b/doc/todo/cloning_direct_mode_repo_over_http.mdwn @@ -34,3 +34,5 @@ the direct mode database either way! --[[Joey]] [[!meta tag=deprecateddirectmode]] + +> direct mode has been removed, so [[done]] --[[Joey]] diff --git a/doc/todo/sqlite_database_improvements.mdwn b/doc/todo/sqlite_database_improvements.mdwn index bbae29e761..fdb64738b8 100644 --- a/doc/todo/sqlite_database_improvements.mdwn +++ b/doc/todo/sqlite_database_improvements.mdwn @@ -52,13 +52,21 @@ process. > solve the encoding problem other than changing the encoding > SKey, IKey, and SFilePath in a non-backwards-compatible way. > -> (Unless the encoding problem is related to persistent's use of Text -> internally, and could then perhaps be avoided by avoiding that?) +> Probably the encoding problem is actually not in sqlite, but +> in persistent's use of Text internally. I did some tests with sqlite3 +> command and it did not seem to vary query results based on the locale +> when using VARCHAR values. I was able to successfully insert an +> invalid unicode `ff` byte into it, and get the same byte back out. > -> The simplest and best final result would be use a ByteString -> for all of them, and store a blob in sqlite. Attached patch -> shows how to do that, but old git-annex won't be able to read -> the updated databases, and won't know that it can't read them! +> Unfortunately, it's not possible to make persistent not use Text +> for VARCHAR. While its PersistDbSpecific lets a non-Text value be stored +> as VARCHAR, any VARCHAR value coming out of the database gets converted +> to a PersistText. +> +> So that seems to leave using a BLOB to store a ByteString for +> SKey, IKey, and SFilePath. Attached patch shows how to do that, +> but old git-annex won't be able to read the updated databases, +> and won't know that it can't read them! > > This seems to call for a flag day, throwing out the old database > contents and regenerating them from other data: @@ -90,15 +98,9 @@ process. > out of the way won't do; old git-annex will just recreate them and > start with missing data! > -> And, what about users who really need to continue using an old git-annex -> and get bitten by the flag day? +> And, what about users who use a mix of old and new git-annex versions? > -> Should this instead be a annex.version bump from v7 to v8? -> But v5 is also affected for ContentIdentifier and Export and Fsck. -> Don't want v5.1. -> -> > Waiting until v5 is no longer supported and including this in v8 -> > seems the only sure way to avoid backwards compatability issues. +> Seems this needs an annex.version bump from v7 to v8. ---- diff --git a/doc/todo/v7_path_toward_default.mdwn b/doc/todo/v7_path_toward_default.mdwn index ed1abd51a2..4a10007802 100644 --- a/doc/todo/v7_path_toward_default.mdwn +++ b/doc/todo/v7_path_toward_default.mdwn @@ -2,12 +2,8 @@ Tracking v7 progress toward becoming the default. ## step 1: release -done - ## step 2: default for new repositories that used to use direct mode -done - ## step 3: auto-upgrade from direct mode Direct mode is very buggy and limited, so it's easy for v7 (with adjusted @@ -30,8 +26,6 @@ would be a problem. But, regular v5 and v7 repos do work in WSL. -done - ## step 4: default for all new repositories Could probably happen fairly soon after switch of direct mode. @@ -42,8 +36,6 @@ avoids the problems discussed in step 5. ## step 5: automatic v5 to v7 upgrades -`v7-default` branch in git has this. - Since v5 repos and v7 repos not using unlocked files are functionally almost identical, this is unlikely to break much. Unlocking files will of course change behavior though. @@ -87,3 +79,6 @@ and so is blocked on v5 auto-upgrading. This won't simplify much code, worth doing eventually. Once automatic v5 to v7 upgrades happen, the remaining v5 specific code is not needed any longer. + +> all now [[done]] + diff --git a/doc/todo/wishlist__58___pack_metadata_in_direct_mode.mdwn b/doc/todo/wishlist__58___pack_metadata_in_direct_mode.mdwn index 1d52ff5121..18131d81fb 100644 --- a/doc/todo/wishlist__58___pack_metadata_in_direct_mode.mdwn +++ b/doc/todo/wishlist__58___pack_metadata_in_direct_mode.mdwn @@ -3,3 +3,7 @@ The metadata storage for direct mode (V3) is this. In directory .git/annex/objec It would be great if these files are packed, maybe also in the git pack files format. [[!meta tag=deprecateddirectmode]] + +> direct mode has been removed. Its replacement, v7 unlocked, does use a +> sqlite database that packs all the metadata in one place. [[done]] +> --[[Joey]] diff --git a/doc/upgrades.mdwn b/doc/upgrades.mdwn index ee0b231478..d469aec4a8 100644 --- a/doc/upgrades.mdwn +++ b/doc/upgrades.mdwn @@ -55,6 +55,8 @@ were added in v7. See below for details about what's new in v6/v7. ## v5 -> v6 (git-annex version 6.x) +v5 repositories are automatically upgraded to v6. + A v6 git-annex repository can have some files locked while other files are unlocked, and all git and git-annex commands can be used on both locked and unlocked files. It's a good idea to make sure that all users of the @@ -89,11 +91,6 @@ same tradeoff. See [[tips/unlocked_files/]] for more details about locked files and thin mode. -Normally you will need to run git-annex upgrade to perform this upgrade. -But, when a new enough git-annex is used in a direct mode repository, -it will be automatically upgraded and configured to use unlocked files -instead of direct mode. - ## v4 -> v5 (git-annex version 5.x) The upgrade from v4 to v5 is handled