diff --git a/Annex.hs b/Annex.hs --- a/Annex.hs +++ b/Annex.hs @@ -118,7 +118,7 @@ , 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 --- a/Annex/AdjustedBranch.hs +++ b/Annex/AdjustedBranch.hs @@ -26,7 +26,6 @@ propigateAdjustedCommits, AdjustedClone(..), checkAdjustedClone, - isSupported, checkVersionSupported, isGitVersionSupported, ) where @@ -50,7 +49,6 @@ 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 @@ (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 @@ 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/AutoMerge.hs b/Annex/AutoMerge.hs --- a/Annex/AutoMerge.hs +++ b/Annex/AutoMerge.hs @@ -13,7 +13,6 @@ import Annex.Common import qualified Annex.Queue -import Annex.Direct import Annex.CatFile import Annex.Link import Annex.Content @@ -25,7 +24,6 @@ import qualified Git.Branch import Git.Types (TreeItemType(..), fromTreeItemType) import Git.FilePath -import Config import Annex.ReplaceFile import Annex.VariantFile import qualified Database.Keys @@ -50,9 +48,7 @@ Nothing -> go Nothing Just b -> go =<< inRepo (Git.Ref.sha b) where - go old = ifM isDirect - ( mergeDirect currbranch old branch resolvemerge mergeconfig commitmode - , do + go old = do r <- inRepo (Git.Merge.merge branch mergeconfig commitmode) <||> (resolvemerge <&&> commitResolvedMerge commitmode) -- Merging can cause new associated files to appear @@ -61,7 +57,6 @@ -- close the database if it was open. Database.Keys.closeDb return r - ) where resolvemerge = ifM canresolvemerge ( resolveMerge old branch False @@ -88,13 +83,9 @@ - the other as a directory or non-annexed file. The annexed file - is renamed to resolve the merge, and the other object is preserved as-is. - - - In indirect mode, the merge is resolved in the work tree and files + - The merge is resolved in the work tree and files - staged, to clean up from a conflicted merge that was run in the work - tree. - - - - In direct mode, the work tree is not touched here; files are staged to - - the index, and written to the gitAnnexMergeDir, for later handling by - - the direct mode merge code. - - This is complicated by needing to support merges run in an overlay - work tree, in which case the CWD won't be within the work tree. @@ -126,7 +117,7 @@ let merged = not (null mergedfs') void $ liftIO cleanup - unlessM (pure inoverlay <||> isDirect) $ do + unless inoverlay $ do (deleted, cleanup2) <- inRepo (LsFiles.deleted [top]) unless (null deleted) $ Annex.Queue.addCommand "rm" @@ -136,7 +127,7 @@ when merged $ do Annex.Queue.flush - unlessM (pure inoverlay <||> isDirect) $ do + unless inoverlay $ do unstagedmap <- inodeMap $ inRepo $ LsFiles.notInRepo False [top] cleanConflictCruft mergedks' mergedfs' unstagedmap showLongNote "Merge conflict was automatically resolved; you may want to examine the result." @@ -230,12 +221,7 @@ Database.Keys.addAssociatedFile key =<< inRepo (toTopFilePath dest) - withworktree f a = ifM isDirect - ( do - d <- fromRepo gitAnnexMergeDir - a (d f) - , a f - ) + withworktree f a = a f {- Stage a graft of a directory or file from a branch - and update the work tree. -} diff --git a/Annex/CheckIgnore.hs b/Annex/CheckIgnore.hs --- a/Annex/CheckIgnore.hs +++ b/Annex/CheckIgnore.hs @@ -19,23 +19,19 @@ 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/Content.hs b/Annex/Content.hs --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -1,6 +1,6 @@ {- git-annex file content managing - - - Copyright 2010-2018 Joey Hess + - Copyright 2010-2019 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -38,7 +38,7 @@ removeAnnex, moveBad, KeyLocation(..), - getKeysPresent, + listKeys, saveState, downloadUrl, preseedTmp, @@ -70,12 +70,9 @@ import qualified Annex.Url as Url import Utility.CopyFile import Utility.Metered -import Config import Git.FilePath import Annex.Perms import Annex.Link -import qualified Annex.Content.Direct as Direct -import Annex.ReplaceFile import Annex.LockPool import Messages.Progress import Types.Remote (unVerified, Verification(..), RetrievalSecurityPolicy(..)) @@ -103,36 +100,22 @@ {- inAnnex that performs an arbitrary check of the key's content. -} inAnnex' :: (a -> Bool) -> a -> (FilePath -> Annex a) -> Key -> Annex a -inAnnex' isgood bad check key = withObjectLoc key checkindirect checkdirect - where - checkindirect loc = do - r <- check loc - if isgood r - then ifM (annexThin <$> Annex.getGitConfig) - -- When annex.thin is set, the object file - -- could be modified; make sure it's not. - -- (Suppress any messages about - -- checksumming, to avoid them cluttering - -- the display.) - ( ifM (doQuietAction $ isUnmodified key loc) - ( return r - , return bad - ) - , return r - ) - else return bad - - -- In direct mode, at least one of the associated files must pass the - -- check. Additionally, the file must be unmodified. - checkdirect [] = return bad - checkdirect (loc:locs) = do - r <- check loc - if isgood r - then ifM (Direct.goodContent key loc) +inAnnex' isgood bad check key = withObjectLoc key $ \loc -> do + r <- check loc + if isgood r + then ifM (annexThin <$> Annex.getGitConfig) + -- When annex.thin is set, the object file + -- could be modified; make sure it's not. + -- (Suppress any messages about + -- checksumming, to avoid them cluttering + -- the display.) + ( ifM (doQuietAction $ isUnmodified key loc) ( return r - , checkdirect locs + , return bad ) - else checkdirect locs + , return r + ) + else return bad {- Like inAnnex, checks if the object file for a key exists, - but there are no guarantees it has the right content. -} @@ -148,15 +131,13 @@ is_unlocked = Just True is_missing = Just False - go contentfile = maybe (checkindirect contentfile) (checkdirect contentfile) - =<< contentLockFile key + go contentfile = flip checklock contentfile =<< contentLockFile key #ifndef mingw32_HOST_OS - checkindirect contentfile = checkOr is_missing contentfile - {- In direct mode, the content file must exist, but - - the lock file generally won't exist unless a removal is in - - process. -} - checkdirect contentfile lockfile = + checklock Nothing contentfile = checkOr is_missing contentfile + {- The content file must exist, but the lock file generally + - won't exist unless a removal is in process. -} + checklock (Just lockfile) contentfile = ifM (liftIO $ doesFileExist contentfile) ( checkOr is_unlocked lockfile , return is_missing @@ -166,8 +147,8 @@ Just True -> is_locked Just False -> is_unlocked #else - checkindirect f = liftIO $ ifM (doesFileExist f) - ( lockShared f >>= \case + checklock Nothing contentfile = liftIO $ ifM (doesFileExist contentfile) + ( lockShared contentfile >>= \case Nothing -> return is_locked Just lockhandle -> do dropLock lockhandle @@ -176,7 +157,7 @@ ) {- In Windows, see if we can take a shared lock. If so, - remove the lock file to clean up after ourselves. -} - checkdirect contentfile lockfile = + checklock (Just lockfile) contentfile = ifM (liftIO $ doesFileExist contentfile) ( modifyContent lockfile $ liftIO $ lockShared lockfile >>= \case @@ -189,15 +170,12 @@ ) #endif -{- Direct mode and especially Windows has to use a separate lock - - file from the content, since locking the actual content file - - would interfere with the user's use of it. -} +{- Windows has to use a separate lock file from the content, since + - locking the actual content file would interfere with the user's + - use of it. -} contentLockFile :: Key -> Annex (Maybe FilePath) #ifndef mingw32_HOST_OS -contentLockFile key = ifM isDirect - ( Just <$> calcRepo (gitAnnexContentLock key) - , return Nothing - ) +contentLockFile _ = pure Nothing #else contentLockFile key = Just <$> calcRepo (gitAnnexContentLock key) #endif @@ -207,9 +185,6 @@ - - If locking fails, or the content is not present, throws an exception - rather than running the action. - - - - Note that, in direct mode, nothing prevents the user from directly - - editing or removing the content, even while it's locked by this. -} lockContentShared :: Key -> (VerifiedCopy -> Annex a) -> Annex a lockContentShared key a = lockContentUsing lock key $ ifM (inAnnex key) @@ -467,8 +442,6 @@ - - When a key has associated pointer files, the object is hard - linked (or copied) to the files, and the object file is left thawed. - - - - In direct mode, moves the object file to the associated file, or files. - - What if the key there already has content? This could happen for - various reasons; perhaps the same content is being annexed again. @@ -496,7 +469,7 @@ moveAnnex :: Key -> FilePath -> Annex Bool moveAnnex key src = ifM (checkSecureHashes key) ( do - withObjectLoc key storeobject storedirect + withObjectLoc key storeobject return True , return False ) @@ -513,32 +486,6 @@ ics <- mapM (populatePointerFile (Restage True) key dest) fs Database.Keys.storeInodeCaches' key [dest] (catMaybes ics) ) - storeindirect = storeobject =<< calcRepo (gitAnnexLocation key) - - {- In direct mode, the associated file's content may be locally - - modified. In that case, it's preserved. However, the content - - we're moving into the annex may be the only extant copy, so - - it's important we not lose it. So, when the key's content - - cannot be moved to any associated file, it's stored in indirect - - mode. - -} - storedirect = storedirect' storeindirect - storedirect' fallback [] = fallback - storedirect' fallback (f:fs) = do - thawContent src - v <- isAnnexLink f - if Just key == v - then do - Direct.updateInodeCache key src - replaceFile f $ liftIO . moveFile src - chmodContent f - forM_ fs $ - Direct.addContentWhenNotPresent key f - else ifM (Direct.goodContent key f) - ( storedirect' alreadyhave fs - , storedirect' fallback fs - ) - alreadyhave = liftIO $ removeFile src checkSecureHashes :: Key -> Annex Bool @@ -647,8 +594,8 @@ {- Returns a file that contains an object's content, - and a check to run after the transfer is complete. - - - When a file is unlocked (or in direct mode), it's possble for its - - content to change as it's being sent. The check detects this case + - When a file is unlocked, it's possble for its content to + - change as it's being sent. The check detects this case - and returns False. - - Note that the returned check action is, in some cases, run in the @@ -656,47 +603,24 @@ - the sender. So it cannot rely on Annex state. -} prepSendAnnex :: Key -> Annex (Maybe (FilePath, Annex Bool)) -prepSendAnnex key = withObjectLoc key indirect direct - where - indirect f = do - cache <- Database.Keys.getInodeCaches key - cache' <- if null cache - -- Since no inode cache is in the database, this - -- object is not currently unlocked. But that could - -- change while the transfer is in progress, so - -- generate an inode cache for the starting - -- content. - then maybeToList <$> - withTSDelta (liftIO . genInodeCache f) - else pure cache - return $ if null cache' - then Nothing - else Just (f, sameInodeCache f cache') - direct [] = return Nothing - direct (f:fs) = do - cache <- Direct.recordedInodeCache key - -- check that we have a good file - ifM (sameInodeCache f cache) - ( return $ Just (f, sameInodeCache f cache) - , direct fs - ) +prepSendAnnex key = withObjectLoc key $ \f -> do + cache <- Database.Keys.getInodeCaches key + cache' <- if null cache + -- Since no inode cache is in the database, this + -- object is not currently unlocked. But that could + -- change while the transfer is in progress, so + -- generate an inode cache for the starting + -- content. + then maybeToList <$> + withTSDelta (liftIO . genInodeCache f) + else pure cache + return $ if null cache' + then Nothing + else Just (f, sameInodeCache f cache') -{- Performs an action, passing it the location to use for a key's content. - - - - In direct mode, the associated files will be passed. But, if there are - - no associated files for a key, the indirect mode action will be - - performed instead. -} -withObjectLoc :: Key -> (FilePath -> Annex a) -> ([FilePath] -> Annex a) -> Annex a -withObjectLoc key indirect direct = ifM isDirect - ( do - fs <- Direct.associatedFiles key - if null fs - then goindirect - else direct fs - , goindirect - ) - where - goindirect = indirect =<< calcRepo (gitAnnexLocation key) +{- Performs an action, passing it the location to use for a key's content. -} +withObjectLoc :: Key -> (FilePath -> Annex a) -> Annex a +withObjectLoc key a = a =<< calcRepo (gitAnnexLocation key) cleanObjectLoc :: Key -> Annex () -> Annex () cleanObjectLoc key cleaner = do @@ -714,17 +638,15 @@ {- Removes a key's file from .git/annex/objects/ -} removeAnnex :: ContentRemovalLock -> Annex () -removeAnnex (ContentRemovalLock key) = withObjectLoc key remove removedirect - where - remove file = cleanObjectLoc key $ do +removeAnnex (ContentRemovalLock key) = withObjectLoc key $ \file -> + cleanObjectLoc key $ do secureErase file liftIO $ nukeFile file g <- Annex.gitRepo mapM_ (\f -> void $ tryIO $ resetpointer $ fromTopFilePath f g) =<< Database.Keys.getAssociatedFiles key Database.Keys.removeInodeCaches key - Direct.removeInodeCache key - + where -- Check associated pointer file for modifications, and reset if -- it's unmodified. resetpointer file = ifM (isUnmodified key file) @@ -736,18 +658,6 @@ , void $ tryIO $ thawContent file ) - -- In direct mode, deletes the associated files or files, and replaces - -- them with symlinks. - removedirect fs = do - cache <- Direct.recordedInodeCache key - Direct.removeInodeCache key - mapM_ (resetfile cache) fs - - resetfile cache f = whenM (Direct.sameInodeCache f cache) $ do - l <- calcRepo $ gitAnnexLink f key - secureErase f - replaceFile f $ makeAnnexLink l - {- Check if a file contains the unmodified content of the key. - - The expensive way to tell is to do a verification of its content. @@ -802,35 +712,32 @@ logStatus key InfoMissing return dest -data KeyLocation = InAnnex | InRepository | InAnywhere +data KeyLocation = InAnnex | InAnywhere -{- List of keys whose content exists in the specified location. - - - InAnnex only lists keys with content in .git/annex/objects, - - while InRepository, in direct mode, also finds keys with content - - in the work tree. InAnywhere lists all keys that have directories - - in .git/annex/objects, whether or not the content is present. - - - - Note that InRepository has to check whether direct mode files - - have goodContent. +{- InAnnex only lists keys with content in .git/annex/objects. + - InAnywhere lists all keys that have directories in + - .git/annex/objects, whether or not the content is present. -} -getKeysPresent :: KeyLocation -> Annex [Key] -getKeysPresent keyloc = do - direct <- isDirect +listKeys :: KeyLocation -> Annex [Key] +listKeys keyloc = do dir <- fromRepo gitAnnexObjectDir - s <- getstate direct + {- In order to run Annex monad actions within unsafeInterleaveIO, + - the current state is taken and reused. No changes made to this + - state will be preserved. + -} + s <- Annex.getState id depth <- gitAnnexLocationDepth <$> Annex.getGitConfig - liftIO $ walk s direct depth dir + liftIO $ walk s depth dir where - walk s direct depth dir = do + walk s depth dir = do contents <- catchDefaultIO [] (dirContents dir) if depth < 2 then do - contents' <- filterM (present s direct) contents + contents' <- filterM (present s) contents let keys = mapMaybe (fileKey . takeFileName) contents' continue keys [] else do - let deeper = walk s direct (depth - 1) + let deeper = walk s (depth - 1) continue [] (map deeper contents) continue keys [] = return keys continue keys (a:as) = do @@ -842,32 +749,11 @@ InAnywhere -> True _ -> False - present _ _ _ | inanywhere = pure True - present _ False d = presentInAnnex d - present s True d = presentDirect s d <||> presentInAnnex d + present _ _ | inanywhere = pure True + present _ d = presentInAnnex d presentInAnnex = doesFileExist . contentfile contentfile d = d takeFileName d - - presentDirect s d = case keyloc of - InAnnex -> return False - InRepository -> case fileKey (takeFileName d) of - Nothing -> return False - Just k -> Annex.eval s $ - anyM (Direct.goodContent k) =<< Direct.associatedFiles k - InAnywhere -> return True - - {- In order to run Annex monad actions within unsafeInterleaveIO, - - the current state is taken and reused. No changes made to this - - state will be preserved. - - - - As an optimsation, call inodesChanged to prime the state with - - a cached value that will be used in the call to goodContent. - -} - getstate direct = do - when direct $ - void inodesChanged - Annex.getState id {- Things to do to record changes to content when shutting down. - diff --git a/Annex/Content/Direct.hs b/Annex/Content/Direct.hs deleted file mode 100644 --- a/Annex/Content/Direct.hs +++ /dev/null @@ -1,181 +0,0 @@ -{- git-annex file content managing for direct mode - - - - This is deprecated, and will be removed when direct mode gets removed - - from git-annex. - - - - Copyright 2012-2014 Joey Hess - - - - Licensed under the GNU AGPL version 3 or higher. - -} - -module Annex.Content.Direct ( - associatedFiles, - associatedFilesRelative, - removeAssociatedFile, - removeAssociatedFileUnchecked, - removeAssociatedFiles, - addAssociatedFile, - goodContent, - recordedInodeCache, - updateInodeCache, - addInodeCache, - writeInodeCache, - compareInodeCaches, - sameInodeCache, - elemInodeCaches, - sameFileStatus, - removeInodeCache, - toInodeCache, - addContentWhenNotPresent, -) where - -import Annex.Common -import Annex.Perms -import qualified Git -import Logs.Location -import Logs.File -import Utility.InodeCache -import Utility.CopyFile -import Annex.ReplaceFile -import Annex.Link -import Annex.InodeSentinal - -{- Absolute FilePaths of Files in the tree that are associated with a key. -} -associatedFiles :: Key -> Annex [FilePath] -associatedFiles key = do - files <- associatedFilesRelative key - top <- fromRepo Git.repoPath - return $ map (top ) files - -{- List of files in the tree that are associated with a key, relative to - - the top of the repo. -} -associatedFilesRelative :: Key -> Annex [FilePath] -associatedFilesRelative key = do - mapping <- calcRepo $ gitAnnexMapping key - liftIO $ catchDefaultIO [] $ withFile mapping ReadMode $ \h -> - -- Read strictly to ensure the file is closed - -- before changeAssociatedFiles tries to write to it. - -- (Especially needed on Windows.) - lines <$> hGetContentsStrict h - -{- Changes the associated files information for a key, applying a - - transformation to the list. Returns new associatedFiles value. -} -changeAssociatedFiles :: Key -> ([FilePath] -> [FilePath]) -> Annex [FilePath] -changeAssociatedFiles key transform = do - mapping <- calcRepo $ gitAnnexMapping key - files <- associatedFilesRelative key - let files' = transform files - when (files /= files') $ - modifyContent mapping $ - writeLogFile mapping $ unlines files' - top <- fromRepo Git.repoPath - return $ map (top ) files' - -{- Removes the list of associated files. -} -removeAssociatedFiles :: Key -> Annex () -removeAssociatedFiles key = do - mapping <- calcRepo $ gitAnnexMapping key - modifyContent mapping $ - liftIO $ nukeFile mapping - -{- Removes an associated file. Returns new associatedFiles value. - - Checks if this was the last copy of the object, and updates location - - log. -} -removeAssociatedFile :: Key -> FilePath -> Annex [FilePath] -removeAssociatedFile key file = do - fs <- removeAssociatedFileUnchecked key file - when (null fs) $ - logStatus key InfoMissing - return fs - -{- Removes an associated file. Returns new associatedFiles value. -} -removeAssociatedFileUnchecked :: Key -> FilePath -> Annex [FilePath] -removeAssociatedFileUnchecked key file = do - file' <- normaliseAssociatedFile file - changeAssociatedFiles key $ filter (/= file') - -{- Adds an associated file. Returns new associatedFiles value. -} -addAssociatedFile :: Key -> FilePath -> Annex [FilePath] -addAssociatedFile key file = do - file' <- normaliseAssociatedFile file - changeAssociatedFiles key $ \files -> - if file' `elem` files - then files - else file':files - -{- Associated files are always stored relative to the top of the repository. - - The input FilePath is relative to the CWD, or is absolute. -} -normaliseAssociatedFile :: FilePath -> Annex FilePath -normaliseAssociatedFile file = do - top <- fromRepo Git.repoPath - liftIO $ relPathDirToFile top file - -{- Checks if a file in the tree, associated with a key, has not been modified. - - - - To avoid needing to fsck the file's content, which can involve an - - expensive checksum, this relies on a cache that contains the file's - - expected mtime and inode. - -} -goodContent :: Key -> FilePath -> Annex Bool -goodContent key file = sameInodeCache file =<< recordedInodeCache key - -{- Gets the recorded inode cache for a key. - - - - A key can be associated with multiple files, so may return more than - - one. -} -recordedInodeCache :: Key -> Annex [InodeCache] -recordedInodeCache key = withInodeCacheFile key $ \f -> - liftIO $ catchDefaultIO [] $ - mapMaybe readInodeCache . lines <$> readFileStrict f - -{- Caches an inode for a file. - - - - Anything else already cached is preserved. - -} -updateInodeCache :: Key -> FilePath -> Annex () -updateInodeCache key file = maybe noop (addInodeCache key) - =<< withTSDelta (liftIO . genInodeCache file) - -{- Adds another inode to the cache for a key. -} -addInodeCache :: Key -> InodeCache -> Annex () -addInodeCache key cache = do - oldcaches <- recordedInodeCache key - unlessM (elemInodeCaches cache oldcaches) $ - writeInodeCache key (cache:oldcaches) - -{- Writes inode cache for a key. -} -writeInodeCache :: Key -> [InodeCache] -> Annex () -writeInodeCache key caches = withInodeCacheFile key $ \f -> - modifyContent f $ - liftIO $ writeFile f $ - unlines $ map showInodeCache caches - -{- Removes an inode cache. -} -removeInodeCache :: Key -> Annex () -removeInodeCache key = withInodeCacheFile key $ \f -> - modifyContent f $ - liftIO $ nukeFile f - -withInodeCacheFile :: Key -> (FilePath -> Annex a) -> Annex a -withInodeCacheFile key a = a =<< calcRepo (gitAnnexInodeCache key) - -{- Checks if a FileStatus matches the recorded InodeCache of a file. -} -sameFileStatus :: Key -> FilePath -> FileStatus -> Annex Bool -sameFileStatus key f status = do - old <- recordedInodeCache key - curr <- withTSDelta $ \delta -> liftIO $ toInodeCache delta f status - case (old, curr) of - (_, Just c) -> elemInodeCaches c old - ([], Nothing) -> return True - _ -> return False - -{- Copies the contentfile to the associated file, if the associated - - file has no content. If the associated file does have content, - - even if the content differs, it's left unchanged. -} -addContentWhenNotPresent :: Key -> FilePath -> FilePath -> Annex () -addContentWhenNotPresent key contentfile associatedfile = do - v <- isAnnexLink associatedfile - when (Just key == v) $ - replaceFile associatedfile $ - liftIO . void . copyFileExternal CopyAllMetaData contentfile - updateInodeCache key associatedfile diff --git a/Annex/Content/LowLevel.hs b/Annex/Content/LowLevel.hs --- a/Annex/Content/LowLevel.hs +++ b/Annex/Content/LowLevel.hs @@ -48,12 +48,11 @@ linkOrCopy = linkOrCopy' (annexThin <$> Annex.getGitConfig) linkOrCopy' :: Annex Bool -> Key -> FilePath -> FilePath -> Maybe FileMode -> Annex (Maybe LinkedOrCopied) -linkOrCopy' canhardlink key src dest destmode - | otherwise = catchDefaultIO Nothing $ - ifM canhardlink - ( hardlink - , copy =<< getstat - ) +linkOrCopy' canhardlink key src dest destmode = catchDefaultIO Nothing $ + ifM canhardlink + ( hardlink + , copy =<< getstat + ) where hardlink = do s <- getstat diff --git a/Annex/Direct.hs b/Annex/Direct.hs deleted file mode 100644 --- a/Annex/Direct.hs +++ /dev/null @@ -1,484 +0,0 @@ -{- git-annex direct mode - - - - This is deprecated, and will be removed when direct mode gets removed - - from git-annex. - - - - Copyright 2012-2014 Joey Hess - - - - Licensed under the GNU AGPL version 3 or higher. - -} - -module Annex.Direct where - -import Annex.Common -import qualified Annex -import qualified Git -import qualified Git.LsFiles -import qualified Git.Merge -import qualified Git.DiffTree as DiffTree -import qualified Git.Config -import qualified Git.Ref -import qualified Git.Branch -import Git.Sha -import Git.FilePath -import Git.Types -import Config -import Annex.CatFile -import qualified Annex.Queue -import Logs.Location -import Backend -import Types.KeySource -import Annex.Content -import Annex.Content.Direct -import Annex.Link -import Utility.InodeCache -import Utility.CopyFile -import Annex.Perms -import Annex.ReplaceFile -import Annex.VariantFile -import Git.Index -import Annex.GitOverlay -import Annex.LockFile -import Annex.InodeSentinal -import Utility.Metered - -{- Uses git ls-files to find files that need to be committed, and stages - - them into the index. Returns True if some changes were staged. -} -stageDirect :: Annex Bool -stageDirect = do - Annex.Queue.flush - top <- fromRepo Git.repoPath - (l, cleanup) <- inRepo $ Git.LsFiles.stagedOthersDetails [top] - forM_ l go - void $ liftIO cleanup - staged <- Annex.Queue.size - Annex.Queue.flush - return $ staged /= 0 - where - {- Determine what kind of modified or deleted file this is, as - - efficiently as we can, by getting any key that's associated - - with it in git, as well as its stat info. -} - go (file, Just sha, Just _mode) = withTSDelta $ \delta -> do - shakey <- catKey sha - mstat <- liftIO $ catchMaybeIO $ getSymbolicLinkStatus file - mcache <- liftIO $ maybe (pure Nothing) (toInodeCache delta file) mstat - filekey <- isAnnexLink file >>= \case - Just k -> return (Just k) - -- v7 unlocked pointer file - Nothing -> liftIO (isPointerFile file) - case (shakey, filekey, mstat, mcache) of - (_, Just key, _, _) - | shakey == filekey -> noop - {- A changed symlink. -} - | otherwise -> stageannexlink file key - (Just key, _, _, Just cache) -> do - {- All direct mode files will show as - - modified, so compare the cache to see if - - it really was. -} - oldcache <- recordedInodeCache key - case oldcache of - [] -> modifiedannexed file key cache - _ -> unlessM (elemInodeCaches cache oldcache) $ - modifiedannexed file key cache - (Just key, _, Nothing, _) -> deletedannexed file key - (Nothing, _, Nothing, _) -> deletegit file - (_, _, Just _, _) -> addgit file - go _ = noop - - modifiedannexed file oldkey cache = do - void $ removeAssociatedFile oldkey file - void $ addDirect file cache - - deletedannexed file key = do - void $ removeAssociatedFile key file - deletegit file - - stageannexlink file key = do - l <- calcRepo $ gitAnnexLink file key - stageSymlink file =<< hashSymlink l - void $ addAssociatedFile key file - - addgit file = Annex.Queue.addCommand "add" [Param "-f"] [file] - - deletegit file = Annex.Queue.addCommand "rm" [Param "-qf"] [file] - -{- Run before a commit to update direct mode bookeeping to reflect the - - staged changes being committed. -} -preCommitDirect :: Annex Bool -preCommitDirect = do - (diffs, clean) <- inRepo $ DiffTree.diffIndex Git.Ref.headRef - makeabs <- flip fromTopFilePath <$> gitRepo - forM_ diffs (go makeabs) - liftIO clean - where - go makeabs diff = do - withkey (DiffTree.srcsha diff) (DiffTree.srcmode diff) removeAssociatedFile - withkey (DiffTree.dstsha diff) (DiffTree.dstmode diff) addAssociatedFile - where - withkey sha _mode a = when (sha /= nullSha) $ - catKey sha >>= \case - Nothing -> noop - Just key -> void $ a key $ - makeabs $ DiffTree.file diff - -{- Adds a file to the annex in direct mode. Can fail, if the file is - - modified or deleted while it's being added. -} -addDirect :: FilePath -> InodeCache -> Annex Bool -addDirect file cache = do - showStart "add" file - let source = KeySource - { keyFilename = file - , contentLocation = file - , inodeCache = Just cache - } - got =<< genKey source nullMeterUpdate=<< chooseBackend file - where - got Nothing = do - showEndFail - return False - got (Just (key, _)) = ifM (sameInodeCache file [cache]) - ( do - l <- calcRepo $ gitAnnexLink file key - stageSymlink file =<< hashSymlink l - addInodeCache key cache - void $ addAssociatedFile key file - logStatus key InfoPresent - showEndOk - return True - , do - showEndFail - return False - ) - -{- In direct mode, git merge would usually refuse to do anything, since it - - sees present direct mode files as type changed files. - - - - So, to handle a merge, it's run with the work tree set to a temp - - directory, and the merge is staged into a copy of the index. - - Then the work tree is updated to reflect the merge, and - - finally, the merge is committed and the real index updated. - - - - A lock file is used to avoid races with any other caller of mergeDirect. - - - - To avoid other git processes from making changes to the index while our - - merge is in progress, the index lock file is used as the temp index - - file. This is the same as what git does when updating the index - - normally. - -} -mergeDirect :: Maybe Git.Ref -> Maybe Git.Ref -> Git.Branch -> Annex Bool -> [Git.Merge.MergeConfig] -> Git.Branch.CommitMode -> Annex Bool -mergeDirect startbranch oldref branch resolvemerge mergeconfig commitmode = exclusively $ do - reali <- liftIO . absPath =<< fromRepo indexFile - tmpi <- liftIO . absPath =<< fromRepo (indexFileLock . indexFile) - liftIO $ whenM (doesFileExist reali) $ - copyFile reali tmpi - - d <- fromRepo gitAnnexMergeDir - liftIO $ do - whenM (doesDirectoryExist d) $ - removeDirectoryRecursive d - createDirectoryIfMissing True d - - withIndexFile tmpi $ do - merged <- stageMerge d branch mergeconfig commitmode - ok <- if merged - then return True - else resolvemerge - if ok - then do - mergeDirectCleanup d (fromMaybe Git.Sha.emptyTree oldref) - mergeDirectCommit merged startbranch branch commitmode - liftIO $ whenM (doesFileExist tmpi) $ - rename tmpi reali - else do - liftIO $ nukeFile tmpi - liftIO $ removeDirectoryRecursive d - return ok - where - exclusively = withExclusiveLock gitAnnexMergeLock - -{- Stage a merge into the index, avoiding changing HEAD or the current - - branch. -} -stageMerge :: FilePath -> Git.Branch -> [Git.Merge.MergeConfig] -> Git.Branch.CommitMode -> Annex Bool -stageMerge d branch mergeconfig commitmode = do - -- XXX A bug in git makes stageMerge unsafe to use if the git repo - -- is configured with core.symlinks=false - -- Using merge is not ideal though, since it will - -- update the current branch immediately, before the work tree - -- has been updated, which would leave things in an inconsistent - -- state if mergeDirectCleanup is interrupted. - -- - merger <- ifM (coreSymlinks <$> Annex.getGitConfig) - ( return $ \ref -> Git.Merge.stageMerge ref mergeconfig - , return $ \ref -> Git.Merge.merge ref mergeconfig commitmode - ) - inRepo $ \g -> do - wd <- liftIO $ absPath d - gd <- liftIO $ absPath $ Git.localGitDir g - merger branch $ - g { location = Local { gitdir = gd, worktree = Just (addTrailingPathSeparator wd) } } - -{- Commits after a direct mode merge is complete, and after the work - - tree has been updated by mergeDirectCleanup. - -} -mergeDirectCommit :: Bool -> Maybe Git.Ref -> Git.Branch -> Git.Branch.CommitMode -> Annex () -mergeDirectCommit allowff old branch commitmode = do - void preCommitDirect - d <- fromRepo Git.localGitDir - let merge_head = d "MERGE_HEAD" - let merge_msg = d "MERGE_MSG" - let merge_mode = d "MERGE_MODE" - ifM (pure allowff <&&> canff) - ( inRepo $ Git.Branch.update "merge" Git.Ref.headRef branch -- fast forward - , do - msg <- liftIO $ - catchDefaultIO ("merge " ++ fromRef branch) $ - readFile merge_msg - void $ inRepo $ Git.Branch.commit commitmode False msg - Git.Ref.headRef [Git.Ref.headRef, branch] - ) - liftIO $ mapM_ nukeFile [merge_head, merge_msg, merge_mode] - where - canff = maybe (return False) (\o -> inRepo $ Git.Branch.fastForwardable o branch) old - -mergeDirectCleanup :: FilePath -> Git.Ref -> Annex () -mergeDirectCleanup d oldref = updateWorkTree d oldref False - -{- Updates the direct mode work tree to reflect the changes staged in the - - index by a git command, that was run in a temporary work tree. - - - - Uses diff-index to compare the staged changes with provided ref - - which should be the tree before the merge, and applies those - - changes to the work tree. - - - - There are really only two types of changes: An old item can be deleted, - - or a new item added. Two passes are made, first deleting and then - - adding. This is to handle cases where eg, a file is deleted and a - - directory is added. (The diff-tree output may list these in the opposite - - order, but we cannot add the directory until the file with the - - same name is removed.) - -} -updateWorkTree :: FilePath -> Git.Ref -> Bool -> Annex () -updateWorkTree d oldref force = do - (items, cleanup) <- inRepo $ DiffTree.diffIndex oldref - makeabs <- flip fromTopFilePath <$> gitRepo - let fsitems = zip (map (makeabs . DiffTree.file) items) items - forM_ fsitems $ - go makeabs DiffTree.srcsha moveout moveout_raw - forM_ fsitems $ - go makeabs DiffTree.dstsha movein movein_raw - void $ liftIO cleanup - where - go makeabs getsha a araw (f, item) - | getsha item == nullSha = noop - | otherwise = void $ - tryNonAsync . maybe (araw item makeabs f) (\k -> void $ a item makeabs k f) - =<< catKey (getsha item) - - moveout _ _ = removeDirect - - {- Files deleted by the merge are removed from the work tree. - - Empty work tree directories are removed, per git behavior. -} - moveout_raw _ _ f = liftIO $ do - nukeFile f - void $ tryIO $ removeDirectory $ parentDir f - - {- If the file is already present, with the right content for the - - key, it's left alone. - - - - If the file is already present, and does not exist in the - - oldref, preserve this local file. - - - - Otherwise, create the symlink and then if possible, replace it - - with the content. -} - movein item makeabs k f = unlessM (goodContent k f) $ do - unless force $ preserveUnannexed item makeabs f oldref - l <- calcRepo $ gitAnnexLink f k - replaceFile f $ makeAnnexLink l - toDirect k f - - {- Any new, modified, or renamed files were written to the temp - - directory by the merge, and are moved to the real work tree. -} - movein_raw item makeabs f = do - unless force $ preserveUnannexed item makeabs f oldref - liftIO $ do - createDirectoryIfMissing True $ parentDir f - void $ tryIO $ rename (d getTopFilePath (DiffTree.file item)) f - -{- If the file that's being moved in is already present in the work - - tree, but did not exist in the oldref, preserve this - - local, unannexed file (or directory), as "variant-local". - - - - It's also possible that the file that's being moved in - - is in a directory that collides with an exsting, non-annexed - - file (not a directory), which should be preserved. - -} -preserveUnannexed :: DiffTree.DiffTreeItem -> (TopFilePath -> FilePath) -> FilePath -> Ref -> Annex () -preserveUnannexed item makeabs absf oldref = do - whenM (liftIO (collidingitem absf) <&&> unannexed absf) $ - liftIO $ findnewname absf 0 - checkdirs (DiffTree.file item) - where - checkdirs from = case upFrom (getTopFilePath from) of - Nothing -> noop - Just p -> do - let d = asTopFilePath p - let absd = makeabs d - whenM (liftIO (colliding_nondir absd) <&&> unannexed absd) $ - liftIO $ findnewname absd 0 - checkdirs d - - collidingitem f = isJust - <$> catchMaybeIO (getSymbolicLinkStatus f) - colliding_nondir f = maybe False (not . isDirectory) - <$> catchMaybeIO (getSymbolicLinkStatus f) - - unannexed f = (isNothing <$> isAnnexLink f) - <&&> (isNothing <$> catFileDetails oldref f) - - findnewname :: FilePath -> Int -> IO () - findnewname f n = do - let localf = mkVariant f - ("local" ++ if n > 0 then show n else "") - ifM (collidingitem localf) - ( findnewname f (n+1) - , rename f localf - `catchIO` const (findnewname f (n+1)) - ) - -{- If possible, converts a symlink in the working tree into a direct - - mode file. If the content is not available, leaves the symlink - - unchanged. -} -toDirect :: Key -> FilePath -> Annex () -toDirect k f = fromMaybe noop =<< toDirectGen k f - -toDirectGen :: Key -> FilePath -> Annex (Maybe (Annex ())) -toDirectGen k f = do - loc <- calcRepo $ gitAnnexLocation k - ifM (liftIO $ doesFileExist loc) - ( return $ Just $ fromindirect loc - , do - {- Copy content from another direct file. -} - absf <- liftIO $ absPath f - dlocs <- filterM (goodContent k) =<< - filterM (\l -> isNothing <$> getAnnexLinkTarget l) =<< - (filter (/= absf) <$> addAssociatedFile k f) - case dlocs of - [] -> return Nothing - (dloc:_) -> return $ Just $ fromdirect dloc - ) - where - fromindirect loc = do - {- Move content from annex to direct file. -} - updateInodeCache k loc - void $ addAssociatedFile k f - modifyContent loc $ do - thawContent loc - liftIO (replaceFileFrom loc f) - `catchIO` (\_ -> freezeContent loc) - fromdirect loc = do - replaceFile f $ - liftIO . void . copyFileExternal CopyAllMetaData loc - updateInodeCache k f - -{- Removes a direct mode file, while retaining its content in the annex - - (unless its content has already been changed). -} -removeDirect :: Key -> FilePath -> Annex () -removeDirect k f = do - void $ removeAssociatedFileUnchecked k f - unlessM (inAnnex k) $ - -- If moveAnnex rejects the content of the key, - -- treat that the same as its content having changed. - ifM (goodContent k f) - ( unlessM (moveAnnex k f) $ - logStatus k InfoMissing - , logStatus k InfoMissing - ) - liftIO $ do - nukeFile f - void $ tryIO $ removeDirectory $ parentDir f - -{- Called when a direct mode file has been changed. Its old content may be - - lost. -} -changedDirect :: Key -> FilePath -> Annex () -changedDirect oldk f = do - locs <- removeAssociatedFile oldk f - whenM (pure (null locs) <&&> not <$> inAnnex oldk) $ - logStatus oldk InfoMissing - -{- Git config settings to enable/disable direct mode. -} -setDirect :: Bool -> Annex () -setDirect wantdirect = do - if wantdirect - then do - switchHEAD - setbare - else do - setbare - switchHEADBack - setConfig (annexConfig "direct") val - Annex.changeGitConfig $ \c -> c { annexDirect = wantdirect } - where - val = Git.Config.boolConfig wantdirect - coreworktree = ConfigKey "core.worktree" - indirectworktree = ConfigKey "core.indirect-worktree" - setbare = do - -- core.worktree is not compatable with - -- core.bare; git does not allow both to be set, so - -- unset it when enabling direct mode, caching in - -- core.indirect-worktree - if wantdirect - then moveconfig coreworktree indirectworktree - else moveconfig indirectworktree coreworktree - setConfig (ConfigKey Git.Config.coreBare) val - moveconfig src dest = getConfigMaybe src >>= \case - Nothing -> noop - Just wt -> do - unsetConfig src - setConfig dest wt - reloadConfig - -{- Since direct mode sets core.bare=true, incoming pushes could change - - the currently checked out branch. To avoid this problem, HEAD - - is changed to a internal ref that nothing is going to push to. - - - - For refs/heads/master, use refs/heads/annex/direct/master; - - this way things that show HEAD (eg shell prompts) will - - hopefully show just "master". -} -directBranch :: Ref -> Ref -directBranch orighead = case splitc '/' $ fromRef orighead of - ("refs":"heads":"annex":"direct":_) -> orighead - ("refs":"heads":rest) -> - Ref $ "refs/heads/annex/direct/" ++ intercalate "/" rest - _ -> Ref $ "refs/heads/" ++ fromRef (Git.Ref.base orighead) - -{- Converts a directBranch back to the original branch. - - - - Any other ref is left unchanged. - -} -fromDirectBranch :: Ref -> Ref -fromDirectBranch directhead = case splitc '/' $ fromRef directhead of - ("refs":"heads":"annex":"direct":rest) -> - Ref $ "refs/heads/" ++ intercalate "/" rest - _ -> directhead - -switchHEAD :: Annex () -switchHEAD = maybe noop switch =<< inRepo Git.Branch.currentUnsafe - where - switch orighead = do - let newhead = directBranch orighead - maybe noop (inRepo . Git.Branch.update "entering direct mode" newhead) - =<< inRepo (Git.Ref.sha orighead) - inRepo $ Git.Branch.checkout newhead - -switchHEADBack :: Annex () -switchHEADBack = maybe noop switch =<< inRepo Git.Branch.currentUnsafe - where - switch currhead = do - let orighead = fromDirectBranch currhead - inRepo (Git.Ref.sha currhead) >>= \case - Just headsha - | orighead /= currhead -> do - inRepo $ Git.Branch.update "leaving direct mode" orighead headsha - inRepo $ Git.Branch.checkout orighead - inRepo $ Git.Branch.delete currhead - _ -> inRepo $ Git.Branch.checkout orighead diff --git a/Annex/Drop.hs b/Annex/Drop.hs --- a/Annex/Drop.hs +++ b/Annex/Drop.hs @@ -17,7 +17,6 @@ import Command import Annex.Wanted import Config -import Annex.Content.Direct import qualified Database.Keys import Git.FilePath @@ -44,20 +43,13 @@ - A VerifiedCopy can be provided as an optimisation when eg, a key - has just been uploaded to a remote. - - - In direct mode, all associated files are checked, and only if all - - of them are unwanted are they dropped. - - - The runner is used to run CommandStart sequentially, it's typically - callCommandAction. -} handleDropsFrom :: [UUID] -> [Remote] -> Reason -> Bool -> Key -> AssociatedFile -> [VerifiedCopy] -> (CommandStart -> CommandCleanup) -> Annex () handleDropsFrom locs rs reason fromhere key afile preverified runner = do - l <- ifM isDirect - ( associatedFilesRelative key - , do - g <- Annex.gitRepo - map (`fromTopFilePath` g) <$> Database.Keys.getAssociatedFiles key - ) + g <- Annex.gitRepo + l <- map (`fromTopFilePath` g) <$> Database.Keys.getAssociatedFiles key let fs = case afile of AssociatedFile (Just f) -> nub (f : l) AssociatedFile Nothing -> l diff --git a/Annex/Fixup.hs b/Annex/Fixup.hs --- a/Annex/Fixup.hs +++ b/Annex/Fixup.hs @@ -12,7 +12,6 @@ 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 @@ {- 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 --- a/Annex/Ingest.hs +++ b/Annex/Ingest.hs @@ -13,7 +13,6 @@ ingestAdd', ingest, ingest', - finishIngestDirect, finishIngestUnlocked, cleanOldKeys, addLink, @@ -28,12 +27,10 @@ import Types.KeySource import Backend import Annex.Content -import Annex.Content.Direct 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 @@ -137,14 +134,9 @@ let f = keyFilename source if lockingFile cfg then addLink f k mic - else ifM isDirect - ( do - l <- calcRepo $ gitAnnexLink f k - stageSymlink f =<< hashSymlink l - , do - mode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus (contentLocation source) - stagePointerFile f mode =<< hashPointerFile k - ) + else do + mode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus (contentLocation source) + stagePointerFile f mode =<< hashPointerFile k return (Just k) {- Ingests a locked down file into the annex. Does not update the working @@ -170,10 +162,7 @@ where go (Just key) mcache (Just s) | lockingFile cfg = golocked key mcache s - | otherwise = ifM isDirect - ( godirect key mcache s - , gounlocked key mcache s - ) + | otherwise = gounlocked key mcache s go _ _ _ = failure "failed to generate a key" golocked key mcache s = @@ -197,12 +186,6 @@ success key (Just cache) s gounlocked _ _ _ = failure "failed statting file" - godirect key (Just cache) s = do - addInodeCache key cache - finishIngestDirect key source - success key (Just cache) s - godirect _ _ _ = failure "failed statting file" - success k mcache s = do genMetaData k (keyFilename source) s return (Just k, mcache) @@ -212,16 +195,6 @@ cleanCruft source return (Nothing, Nothing) -finishIngestDirect :: Key -> KeySource -> Annex () -finishIngestDirect key source = do - void $ addAssociatedFile key $ keyFilename source - cleanCruft source - - {- Copy to any other locations using the same key. -} - otherfs <- filter (/= keyFilename source) <$> associatedFiles key - forM_ otherfs $ - addContentWhenNotPresent key (keyFilename source) - finishIngestUnlocked :: Key -> KeySource -> Annex () finishIngestUnlocked key source = do cleanCruft source @@ -333,12 +306,10 @@ - Also, when in an adjusted unlocked branch, always add files unlocked. -} addUnlocked :: Annex Bool -addUnlocked = isDirect <||> - (versionSupportsUnlockedPointers <&&> - ((not . coreSymlinks <$> Annex.getGitConfig) <||> - (annexAddUnlocked <$> Annex.getGitConfig) <||> - (maybe False isadjustedunlocked . snd <$> getCurrentBranch) - ) +addUnlocked = + ((not . coreSymlinks <$> Annex.getGitConfig) <||> + (annexAddUnlocked <$> Annex.getGitConfig) <||> + (maybe False isadjustedunlocked . snd <$> getCurrentBranch) ) where isadjustedunlocked (LinkAdjustment UnlockAdjustment) = True @@ -352,7 +323,7 @@ - When the content of the key is not accepted into the annex, returns False. -} addAnnexedFile :: FilePath -> Key -> Maybe FilePath -> Annex Bool -addAnnexedFile file key mtmp = ifM (addUnlocked <&&> not <$> isDirect) +addAnnexedFile file key mtmp = ifM addUnlocked ( do mode <- maybe (pure Nothing) @@ -371,15 +342,8 @@ ) , do addLink file key Nothing - whenM isDirect $ do - void $ addAssociatedFile key file case mtmp of - Just tmp -> do - {- For moveAnnex to work in direct mode, the - - symlink must already exist, so flush the queue. -} - whenM isDirect $ - Annex.Queue.flush - moveAnnex key tmp + Just tmp -> moveAnnex key tmp Nothing -> return True ) where diff --git a/Annex/Init.hs b/Annex/Init.hs --- a/Annex/Init.hs +++ b/Annex/Init.hs @@ -22,7 +22,6 @@ import qualified Git import qualified Git.Config import qualified Git.Objects -import qualified Git.LsFiles import qualified Annex.Branch import Logs.UUID import Logs.Trust.Basic @@ -32,12 +31,11 @@ import Annex.Version import Annex.Difference import Annex.UUID -import Annex.Link import Annex.WorkTree import Config import Config.Files import Config.Smudge -import Annex.Direct +import qualified Upgrade.V5.Direct as Direct import qualified Annex.AdjustedBranch as AdjustedBranch import Annex.Environment import Annex.Hook @@ -50,6 +48,7 @@ import Utility.FileMode import System.Posix.User import qualified Utility.LockFile.Posix as Posix +import Data.Either #endif import qualified Data.Map as M @@ -107,27 +106,22 @@ hookWrite postReceiveHook setDifferences unlessM (isJust <$> getVersion) $ - ifM (crippledFileSystem <&&> (not <$> isBareRepo)) - ( setVersion (fromMaybe versionForCrippledFilesystem mversion) - , setVersion (fromMaybe defaultVersion mversion) - ) - whenM versionSupportsUnlockedPointers $ do - configureSmudgeFilter - scanUnlockedFiles - 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)) - ( adjustToCrippledFilesystem + ( AdjustedBranch.adjustToCrippledFileSystem -- Handle case where this repo was cloned from a -- direct mode repo , unlessM isBareRepo - switchHEADBack + Direct.switchHEADBack ) propigateSecureHashesOnly createInodeSentinalFile False @@ -150,9 +144,9 @@ ensureInitialized = getVersion >>= maybe needsinit checkUpgrade where needsinit = ifM Annex.Branch.hasSibling - ( initialize Nothing Nothing - , giveup "First run: git-annex init" - ) + ( initialize Nothing Nothing + , giveup $ "First run: git-annex init" + ) {- Checks if a repository is initialized. Does not check version for ugrade. -} isInitialized :: Annex Bool @@ -161,7 +155,7 @@ {- A crippled filesystem is one that does not allow making symlinks, - or removing write access from files. -} probeCrippledFileSystem :: Annex Bool -probeCrippledFileSystem = withOtherTmp $ \tmp -> do +probeCrippledFileSystem = withEventuallyCleanedOtherTmp $ \tmp -> do (r, warnings) <- liftIO $ probeCrippledFileSystem' tmp mapM_ warning warnings return r @@ -218,14 +212,15 @@ #ifdef mingw32_HOST_OS return True #else - withOtherTmp $ \tmp -> do + withEventuallyCleanedOtherTmp $ \tmp -> do let f = tmp "lockprobe" mode <- annexFileMode liftIO $ do nukeFile f - ok <- catchBoolIO $ do - Posix.dropLock =<< Posix.lockExclusive (Just mode) f - return True + let locktest = + Posix.lockExclusive (Just mode) f + >>= Posix.dropLock + ok <- isRight <$> tryNonAsync locktest nukeFile f return ok #endif @@ -235,7 +230,7 @@ #ifdef mingw32_HOST_OS return False #else - withOtherTmp $ \tmp -> do + withEventuallyCleanedOtherTmp $ \tmp -> do let f = tmp "gaprobe" let f2 = tmp "gaprobe2" liftIO $ do @@ -281,22 +276,3 @@ propigateSecureHashesOnly = maybe noop (setConfig (ConfigKey "annex.securehashesonly")) =<< getGlobalConfig "annex.securehashesonly" - -adjustToCrippledFilesystem :: Annex () -adjustToCrippledFilesystem = ifM versionSupportsAdjustedBranch - ( ifM (liftIO $ AdjustedBranch.isGitVersionSupported) - ( AdjustedBranch.adjustToCrippledFileSystem - , enableDirectMode - ) - , enableDirectMode - ) - -enableDirectMode :: Annex () -enableDirectMode = unlessM isDirect $ do - warning "Enabling direct mode." - top <- fromRepo Git.repoPath - (l, clean) <- inRepo $ Git.LsFiles.inRepo [top] - forM_ l $ \f -> - maybe noop (`toDirect` f) =<< isAnnexLink f - void $ liftIO clean - setDirect True diff --git a/Annex/Locations.hs b/Annex/Locations.hs --- a/Annex/Locations.hs +++ b/Annex/Locations.hs @@ -266,7 +266,8 @@ gitAnnexTmpOtherLock :: Git.Repo -> FilePath gitAnnexTmpOtherLock r = gitAnnexDir r "othertmp.lck" -{- Tmp directory used by old versions of git-annex. -} +{- .git/annex/misctmp/ was used by old versions of git-annex and is still + - used during initialization -} gitAnnexTmpOtherDirOld :: Git.Repo -> FilePath gitAnnexTmpOtherDirOld r = addTrailingPathSeparator $ gitAnnexDir r "misctmp" diff --git a/Annex/MakeRepo.hs b/Annex/MakeRepo.hs deleted file mode 100644 --- a/Annex/MakeRepo.hs +++ /dev/null @@ -1,90 +0,0 @@ -{- making local repositories (used by webapp mostly) - - - - Copyright 2012-2014 Joey Hess - - - - Licensed under the GNU AGPL version 3 or higher. - -} - -module Annex.MakeRepo where - -import Assistant.WebApp.Common -import Annex.Init -import qualified Git.Construct -import qualified Git.Config -import qualified Git.Command -import qualified Git.Branch -import qualified Annex -import Annex.UUID -import Annex.Direct -import Annex.Action -import Types.StandardGroups -import Logs.PreferredContent -import qualified Annex.Branch -import Utility.Process.Transcript - -{- Makes a new git repository. Or, if a git repository already - - exists, returns False. -} -makeRepo :: FilePath -> Bool -> IO Bool -makeRepo path bare = ifM (probeRepoExists path) - ( return False - , do - (transcript, ok) <- - processTranscript "git" (toCommand params) Nothing - unless ok $ - error $ "git init failed!\nOutput:\n" ++ transcript - return True - ) - where - baseparams = [Param "init", Param "--quiet"] - params - | bare = baseparams ++ [Param "--bare", File path] - | otherwise = baseparams ++ [File path] - -{- Runs an action in the git repository in the specified directory. -} -inDir :: FilePath -> Annex a -> IO a -inDir dir a = do - state <- Annex.new =<< Git.Config.read =<< Git.Construct.fromPath dir - Annex.eval state $ a `finally` stopCoProcesses - -{- Creates a new repository, and returns its UUID. -} -initRepo :: Bool -> Bool -> FilePath -> Maybe String -> Maybe StandardGroup -> IO UUID -initRepo True primary_assistant_repo dir desc mgroup = inDir dir $ do - initRepo' desc mgroup - {- Initialize the master branch, so things that expect - - to have it will work, before any files are added. -} - unlessM (Git.Config.isBare <$> gitRepo) $ - void $ inRepo $ Git.Branch.commitCommand Git.Branch.AutomaticCommit - [ Param "--quiet" - , Param "--allow-empty" - , Param "-m" - , Param "created repository" - ] - {- Repositories directly managed by the assistant use direct mode. - - - - Automatic gc is disabled, as it can be slow. Insted, gc is done - - once a day. - -} - when primary_assistant_repo $ do - setDirect True - inRepo $ Git.Command.run - [Param "config", Param "gc.auto", Param "0"] - getUUID -{- Repo already exists, could be a non-git-annex repo though so - - still initialize it. -} -initRepo False _ dir desc mgroup = inDir dir $ do - initRepo' desc mgroup - getUUID - -initRepo' :: Maybe String -> Maybe StandardGroup -> Annex () -initRepo' desc mgroup = unlessM isInitialized $ do - initialize desc Nothing - u <- getUUID - maybe noop (defaultStandardGroup u) mgroup - {- Ensure branch gets committed right away so it is - - available for merging immediately. -} - Annex.Branch.commit =<< Annex.Branch.commitMessage - -{- Checks if a git repo exists at a location. -} -probeRepoExists :: FilePath -> IO Bool -probeRepoExists dir = isJust <$> - catchDefaultIO Nothing (Git.Construct.checkForRepo dir) diff --git a/Annex/Tmp.hs b/Annex/Tmp.hs --- a/Annex/Tmp.hs +++ b/Annex/Tmp.hs @@ -7,9 +7,8 @@ module Annex.Tmp where -import Common -import Annex -import Annex.Locations +import Annex.Common +import qualified Annex import Annex.LockFile import Annex.Perms import Types.CleanupActions @@ -24,13 +23,30 @@ -- any time. withOtherTmp :: (FilePath -> Annex a) -> Annex a withOtherTmp a = do - addCleanup OtherTmpCleanup cleanupOtherTmp + Annex.addCleanup OtherTmpCleanup cleanupOtherTmp tmpdir <- fromRepo gitAnnexTmpOtherDir tmplck <- fromRepo gitAnnexTmpOtherLock withSharedLock (const tmplck) $ do void $ createAnnexDirectory tmpdir a tmpdir +-- | This uses an alternate temp directory. The action should normally +-- clean up whatever files it writes there, but if it leaves files +-- there (perhaps due to being interrupted), the files will be eventually +-- cleaned up by another git-annex process (after they're a week old). +-- +-- Unlike withOtherTmp, this does not rely on locking working. +-- Its main use is in situations where the state of lockfile is not +-- determined yet, eg during initialization. +withEventuallyCleanedOtherTmp :: (FilePath -> Annex a) -> Annex a +withEventuallyCleanedOtherTmp = bracket setup cleanup + where + setup = do + tmpdir <- fromRepo gitAnnexTmpOtherDirOld + void $ createAnnexDirectory tmpdir + return tmpdir + cleanup = liftIO . void . tryIO . removeDirectory + -- | Cleans up any tmp files that were left by a previous -- git-annex process that got interrupted or failed to clean up after -- itself for some other reason. @@ -42,8 +58,6 @@ void $ tryIO $ tryExclusiveLock (const tmplck) $ do tmpdir <- fromRepo gitAnnexTmpOtherDir void $ liftIO $ tryIO $ removeDirectoryRecursive tmpdir - -- This is only to clean up cruft left by old versions of - -- git-annex; it can be removed eventually. oldtmp <- fromRepo gitAnnexTmpOtherDirOld liftIO $ mapM_ cleanold =<< dirContentsRecursive oldtmp liftIO $ void $ tryIO $ removeDirectory oldtmp -- when empty diff --git a/Annex/UpdateInstead.hs b/Annex/UpdateInstead.hs --- a/Annex/UpdateInstead.hs +++ b/Annex/UpdateInstead.hs @@ -9,19 +9,15 @@ import qualified Annex import Annex.Common -import Config -import Annex.Version import Annex.AdjustedBranch import Git.Branch import Git.ConfigTypes -{- receive.denyCurrentBranch=updateInstead does not work in direct mode - - repositories or when an adjusted branch is checked out, so must be - - emulated. -} +{- receive.denyCurrentBranch=updateInstead does not work + - when an adjusted branch is checked out, so must be emulated. -} needUpdateInsteadEmulation :: Annex Bool -needUpdateInsteadEmulation = updateinsteadset <&&> (isDirect <||> isadjusted) +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 --- a/Annex/Version.hs +++ b/Annex/Version.hs @@ -17,19 +17,13 @@ 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 - -versionForCrippledFilesystem :: RepoVersion -versionForCrippledFilesystem = RepoVersion 7 +supportedVersions = map RepoVersion [7] upgradableVersions :: [RepoVersion] #ifndef mingw32_HOST_OS @@ -42,6 +36,7 @@ autoUpgradeableVersions = M.fromList [ (RepoVersion 3, RepoVersion 5) , (RepoVersion 4, RepoVersion 5) + , (RepoVersion 5, RepoVersion 6) , (RepoVersion 6, RepoVersion 7) ] @@ -50,24 +45,6 @@ getVersion :: Annex (Maybe RepoVersion) getVersion = annexVersion <$> Annex.getGitConfig - -versionSupportsDirectMode :: Annex Bool -versionSupportsDirectMode = go <$> getVersion - where - go (Just v) | v >= RepoVersion 6 = False - go _ = True - -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 --- a/Annex/WorkTree.hs +++ b/Annex/WorkTree.hs @@ -10,13 +10,11 @@ import Annex.Common import Annex.Link import Annex.CatFile -import Annex.Version import Annex.Content import Annex.ReplaceFile import Annex.CurrentBranch import Annex.InodeSentinal import Utility.InodeCache -import Config import Git.FilePath import qualified Git.Ref import qualified Git.LsTree @@ -55,10 +53,7 @@ lookupFile' :: (FilePath -> Annex (Maybe Key)) -> FilePath -> Annex (Maybe Key) lookupFile' catkeyfile file = isAnnexLink file >>= \case Just key -> return (Just key) - Nothing -> ifM (versionSupportsUnlockedPointers <||> isDirect) - ( 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. -} @@ -75,11 +70,11 @@ - when initializing/upgrading a v6+ mode repository. - - Also, the content for the unlocked file may already be present as - - an annex object. If so, make the unlocked file use that content. + - an annex object. If so, make the unlocked file use that content + - when replacefiles is True. -} -scanUnlockedFiles :: Annex () -scanUnlockedFiles = whenM (inRepo Git.Ref.headExists) $ do - showSideAction "scanning for unlocked files" +scanUnlockedFiles :: Bool -> Annex () +scanUnlockedFiles replacefiles = whenM (inRepo Git.Ref.headExists) $ do Database.Keys.runWriter $ liftIO . Database.Keys.SQL.dropAllAssociatedFiles (l, cleanup) <- inRepo $ Git.LsTree.lsTree Git.LsTree.LsTreeRecursive Git.Ref.headRef @@ -97,7 +92,7 @@ let tf = Git.LsTree.file i Database.Keys.runWriter $ liftIO . Database.Keys.SQL.addAssociatedFileFast (toIKey k) tf - whenM (inAnnex k) $ do + whenM (pure replacefiles <&&> inAnnex k) $ do f <- fromRepo $ fromTopFilePath tf destmode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus f ic <- replaceFile f $ \tmp -> diff --git a/Assistant/MakeRepo.hs b/Assistant/MakeRepo.hs new file mode 100644 --- /dev/null +++ b/Assistant/MakeRepo.hs @@ -0,0 +1,93 @@ +{- making local repositories + - + - Copyright 2012-2014 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +module Assistant.MakeRepo where + +import Assistant.WebApp.Common +import Annex.Init +import qualified Git.Construct +import qualified Git.Config +import qualified Git.Command +import qualified Git.Branch +import qualified Annex +import Annex.UUID +import Annex.AdjustedBranch +import Annex.Action +import Types.StandardGroups +import Logs.PreferredContent +import qualified Annex.Branch +import Utility.Process.Transcript +import Config + +{- Makes a new git repository. Or, if a git repository already + - exists, returns False. -} +makeRepo :: FilePath -> Bool -> IO Bool +makeRepo path bare = ifM (probeRepoExists path) + ( return False + , do + (transcript, ok) <- + processTranscript "git" (toCommand params) Nothing + unless ok $ + error $ "git init failed!\nOutput:\n" ++ transcript + return True + ) + where + baseparams = [Param "init", Param "--quiet"] + params + | bare = baseparams ++ [Param "--bare", File path] + | otherwise = baseparams ++ [File path] + +{- Runs an action in the git repository in the specified directory. -} +inDir :: FilePath -> Annex a -> IO a +inDir dir a = do + state <- Annex.new =<< Git.Config.read =<< Git.Construct.fromPath dir + Annex.eval state $ a `finally` stopCoProcesses + +{- Creates a new repository, and returns its UUID. -} +initRepo :: Bool -> Bool -> FilePath -> Maybe String -> Maybe StandardGroup -> IO UUID +initRepo True primary_assistant_repo dir desc mgroup = inDir dir $ do + initRepo' desc mgroup + {- Initialize the master branch, so things that expect + - to have it will work, before any files are added. -} + unlessM (Git.Config.isBare <$> gitRepo) $ + void $ inRepo $ Git.Branch.commitCommand Git.Branch.AutomaticCommit + [ Param "--quiet" + , Param "--allow-empty" + , Param "-m" + , Param "created repository" + ] + {- 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 $ enterAdjustedBranch (LinkAdjustment UnlockAdjustment) + setConfig (annexConfig "thin") (Git.Config.boolConfig True) + inRepo $ Git.Command.run + [Param "config", Param "gc.auto", Param "0"] + getUUID +{- Repo already exists, could be a non-git-annex repo though so + - still initialize it. -} +initRepo False _ dir desc mgroup = inDir dir $ do + initRepo' desc mgroup + getUUID + +initRepo' :: Maybe String -> Maybe StandardGroup -> Annex () +initRepo' desc mgroup = unlessM isInitialized $ do + initialize desc Nothing + u <- getUUID + maybe noop (defaultStandardGroup u) mgroup + {- Ensure branch gets committed right away so it is + - available for merging immediately. -} + Annex.Branch.commit =<< Annex.Branch.commitMessage + +{- Checks if a git repo exists at a location. -} +probeRepoExists :: FilePath -> IO Bool +probeRepoExists dir = isJust <$> + catchDefaultIO Nothing (Git.Construct.checkForRepo dir) diff --git a/Assistant/Threads/Committer.hs b/Assistant/Threads/Committer.hs --- a/Assistant/Threads/Committer.hs +++ b/Assistant/Threads/Committer.hs @@ -20,7 +20,6 @@ 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,11 +31,9 @@ import Annex.Perms import Annex.CatFile import Annex.InodeSentinal -import Annex.Version import Annex.CurrentBranch import qualified Annex import Utility.InodeCache -import Annex.Content.Direct import qualified Database.Keys import qualified Command.Sync import qualified Git.Branch @@ -54,8 +51,7 @@ 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 @@ -240,19 +236,6 @@ 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 (isDirect <||> 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. @@ -275,50 +258,22 @@ handleAdds :: FilePath -> Bool -> Maybe Seconds -> [Change] -> Assistant [Change] handleAdds lockdowndir havelsof delayadd cs = returnWhen (null incomplete) $ do let (pending, inprocess) = partition isPendingAddChange incomplete - direct <- liftAnnex isDirect - unlocked <- liftAnnex versionSupportsUnlockedPointers - let lockingfiles = not (unlocked || direct) let lockdownconfig = LockDownConfig - { lockingFile = lockingfiles + { lockingFile = False , hardlinkFileTmpDir = Just lockdowndir } - (pending', cleanup) <- if unlocked || direct - 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 direct toadd - else forM toadd (add lockdownconfig) - if DirWatcher.eventsCoalesce || null added || unlocked || direct - 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 @@ -330,10 +285,10 @@ 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 @@ -341,10 +296,10 @@ - same InodeCache as the new file. If so, we can just update - bookkeeping, and stage the file in git. -} - addunlocked :: Bool -> [Change] -> Assistant [Maybe Change] - addunlocked isdirect toadd = do + addunlocked :: [Change] -> Assistant [Maybe Change] + addunlocked toadd = do ct <- liftAnnex compareInodeCachesWith - m <- liftAnnex $ removedKeysMap isdirect ct cs + m <- liftAnnex $ removedKeysMap ct cs delta <- liftAnnex getTSDelta let cfg = LockDownConfig { lockingFile = False @@ -359,46 +314,32 @@ Just cache -> case M.lookup (inodeCacheToKey ct cache) m of Nothing -> add cfg c - Just k -> fastadd isdirect c k + Just k -> fastadd c k - fastadd :: Bool -> Change -> Key -> Assistant (Maybe Change) - fastadd isdirect change key = do + fastadd :: Change -> Key -> Assistant (Maybe Change) + fastadd change key = do let source = keySource $ lockedDown change - liftAnnex $ if isdirect - then finishIngestDirect key source - else finishIngestUnlocked key source - done change Nothing (keyFilename source) key + liftAnnex $ finishIngestUnlocked key source + done change (keyFilename source) key - removedKeysMap :: Bool -> InodeComparisonType -> [Change] -> Annex (M.Map InodeCacheKey Key) - removedKeysMap isdirect ct l = do + removedKeysMap :: InodeComparisonType -> [Change] -> Annex (M.Map InodeCacheKey Key) + removedKeysMap ct l = do mks <- forM (filter isRmChange l) $ \c -> catKeyFile $ changeFile c M.fromList . concat <$> mapM mkpairs (catMaybes mks) where mkpairs k = map (\c -> (inodeCacheToKey ct c, k)) <$> - if isdirect - then recordedInodeCache k - else Database.Keys.getInodeCaches k + Database.Keys.getInodeCaches k failedingest change = do refill [retryChange change] 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 <- ifM isDirect - ( calcRepo $ gitAnnexLink file key - , makeLink file key mcache - ) - whenM (pure DirWatcher.eventsCoalesce <||> isDirect) $ - 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/SanityChecker.hs b/Assistant/Threads/SanityChecker.hs --- a/Assistant/Threads/SanityChecker.hs +++ b/Assistant/Threads/SanityChecker.hs @@ -32,7 +32,6 @@ import qualified Assistant.Threads.Watcher as Watcher import Utility.Batch import Utility.NotificationBroadcaster -import Config import Utility.HumanTime import Utility.Tense import Git.Repair @@ -200,8 +199,7 @@ liftAnnex $ warning msg void $ addAlert $ sanityCheckFixAlert msg addsymlink file s = do - isdirect <- liftAnnex isDirect - Watcher.runHandler (Watcher.onAddSymlink isdirect) file s + Watcher.runHandler Watcher.onAddSymlink file s insanity $ "found unstaged symlink: " ++ file hourlyCheck :: Assistant () diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs --- a/Assistant/Threads/Watcher.hs +++ b/Assistant/Threads/Watcher.hs @@ -23,25 +23,22 @@ import Assistant.Alert import Utility.DirWatcher import Utility.DirWatcher.Types +import Utility.InodeCache import qualified Annex import qualified Annex.Queue import qualified Git import qualified Git.UpdateIndex import qualified Git.LsFiles as LsFiles import Annex.WorkTree -import Annex.Direct -import Annex.Content.Direct import Annex.CatFile import Annex.CheckIgnore import Annex.Link import Annex.FileMatcher import Annex.Content import Annex.ReplaceFile -import Annex.Version import Annex.InodeSentinal import Git.Types import Git.FilePath -import Config import Config.GitConfig import Utility.ThreadScheduler import Logs.Location @@ -92,16 +89,10 @@ runWatcher = do startup <- asIO1 startupScan matcher <- liftAnnex largeFilesMatcher - direct <- liftAnnex isDirect - unlocked <- liftAnnex versionSupportsUnlockedPointers symlinkssupported <- liftAnnex $ coreSymlinks <$> Annex.getGitConfig - addhook <- hook $ if unlocked - then onAddUnlocked symlinkssupported matcher - else if direct - then onAddDirect symlinkssupported matcher - else onAdd matcher + addhook <- hook $ onAddUnlocked symlinkssupported matcher delhook <- hook onDel - addsymlinkhook <- hook $ onAddSymlink direct + addsymlinkhook <- hook onAddSymlink deldirhook <- hook onDelDir errhook <- hook onErr let hooks = mkWatchHooks @@ -210,13 +201,6 @@ 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 @@ -224,7 +208,7 @@ onAddUnlocked symlinkssupported matcher f fs = do mk <- liftIO $ isPointerFile f case mk of - Nothing -> onAddUnlocked' False contentchanged addassociatedfile addlink samefilestatus symlinkssupported matcher f fs + Nothing -> onAddUnlocked' contentchanged addassociatedfile addlink samefilestatus symlinkssupported matcher f fs Just k -> addlink f k where addassociatedfile key file = @@ -247,27 +231,15 @@ liftAnnex $ stagePointerFile file mode =<< hashPointerFile key madeChange file $ LinkChange (Just key) -{- In direct mode, add events are received for both new files, and - - modified existing files. - -} -onAddDirect :: Bool -> GetFileMatcher -> Handler -onAddDirect = onAddUnlocked' True changedDirect addassociatedfile addlink sameFileStatus - where - addassociatedfile key file = void $ addAssociatedFile key file - addlink file key = do - link <- liftAnnex $ calcRepo $ gitAnnexLink file key - addLink file link (Just key) - onAddUnlocked' - :: Bool - -> (Key -> FilePath -> Annex ()) + :: (Key -> FilePath -> Annex ()) -> (Key -> FilePath -> Annex ()) -> (FilePath -> Key -> Assistant (Maybe Change)) -> (Key -> FilePath -> FileStatus -> Annex Bool) -> Bool -> GetFileMatcher -> Handler -onAddUnlocked' isdirect contentchanged addassociatedfile addlink samefilestatus symlinkssupported matcher file fs = do +onAddUnlocked' contentchanged addassociatedfile addlink samefilestatus symlinkssupported matcher file fs = do v <- liftAnnex $ catKeyFile file case (v, fs) of (Just key, Just filestatus) -> @@ -306,31 +278,28 @@ Nothing -> noop Just key -> liftAnnex $ addassociatedfile key file - onAddSymlink' (Just $ fromRawFilePath lt) mk isdirect file fs + onAddSymlink' (Just $ fromRawFilePath lt) mk file fs {- A symlink might be an arbitrary symlink, which is just added. - Or, if it is a git-annex symlink, ensure it points to the content - before adding it. -} -onAddSymlink :: Bool -> Handler -onAddSymlink isdirect file filestatus = unlessIgnored file $ do +onAddSymlink :: Handler +onAddSymlink file filestatus = unlessIgnored file $ do linktarget <- liftIO (catchMaybeIO $ readSymbolicLink file) kv <- liftAnnex (lookupFile file) - onAddSymlink' linktarget kv isdirect file filestatus + onAddSymlink' linktarget kv file filestatus -onAddSymlink' :: Maybe String -> Maybe Key -> Bool -> Handler -onAddSymlink' linktarget mk isdirect file filestatus = go mk +onAddSymlink' :: Maybe String -> Maybe Key -> Handler +onAddSymlink' linktarget mk file filestatus = go mk where go (Just key) = do - when isdirect $ - liftAnnex $ void $ addAssociatedFile key file link <- liftAnnex $ calcRepo $ gitAnnexLink file key if linktarget == Just link then ensurestaged (Just link) =<< getDaemonStatus else do - unless isdirect $ - liftAnnex $ replaceFile file $ - makeAnnexLink link + liftAnnex $ replaceFile file $ + makeAnnexLink link addLink file link (Just key) -- other symlink, not git-annex go Nothing = ensurestaged linktarget =<< getDaemonStatus @@ -376,11 +345,7 @@ onDel' :: FilePath -> Annex () onDel' file = do topfile <- inRepo (toTopFilePath file) - ifM versionSupportsUnlockedPointers - ( withkey $ flip Database.Keys.removeAssociatedFile topfile - , whenM isDirect $ - withkey $ \key -> void $ removeAssociatedFile key file - ) + withkey $ flip Database.Keys.removeAssociatedFile topfile Annex.Queue.addUpdateIndex =<< inRepo (Git.UpdateIndex.unstageFile file) where diff --git a/Assistant/Upgrade.hs b/Assistant/Upgrade.hs --- a/Assistant/Upgrade.hs +++ b/Assistant/Upgrade.hs @@ -113,7 +113,7 @@ | transferDirection t == Download = do debug ["finished downloading git-annex distribution"] maybe (failedupgrade "bad download") go - =<< liftAnnex (withObjectLoc k fsckit (getM fsckit)) + =<< liftAnnex (withObjectLoc k fsckit) | otherwise = cleanup where k = distributionKey d diff --git a/Assistant/WebApp/Configurators/Local.hs b/Assistant/WebApp/Configurators/Local.hs --- a/Assistant/WebApp/Configurators/Local.hs +++ b/Assistant/WebApp/Configurators/Local.hs @@ -15,7 +15,7 @@ import Assistant.WebApp.MakeRemote import Assistant.Sync import Assistant.Restart -import Annex.MakeRepo +import Assistant.MakeRepo import qualified Annex import qualified Git import qualified Git.Config diff --git a/Build/BundledPrograms.hs b/Build/BundledPrograms.hs --- a/Build/BundledPrograms.hs +++ b/Build/BundledPrograms.hs @@ -83,5 +83,7 @@ -- its kernel, and avoid using them if not available. ] where +#ifndef mingw32_HOST_OS ifset True s = Just s ifset False _ = Nothing +#endif diff --git a/Build/Configure.hs b/Build/Configure.hs --- a/Build/Configure.hs +++ b/Build/Configure.hs @@ -62,7 +62,7 @@ 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 --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,43 @@ +git-annex (7.20190912) upstream; 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. + * Removed support for git versions older than 2.1. + * assistant: When creating a new repository, no longer use direct + mode, instead use v7 adjusted branches with annex.thin. + * init: When run on a crippled filesystem with --version=5, + will error out, since version 7 is needed for adjusted unlocked branch. + * direct: This command always errors out as direct mode is no longer + supported. + * indirect: This command has become a deprecated noop. + * proxy: This command is deprecated because it was only needed in direct + mode. (But it continues to work.) + * info: Removed the "repository mode" from its output (including the + --json output) since with the removal of direct mode, there is no + repository mode. + * info: When file matching options are specified when getting + info of something other than a directory, they won't have any effect, + so error out to avoid confusion. + * info: Display trust level when getting info on a uuid, same as a remote. + * When upgrading a direct mode repo to v7 with adjusted unlocked branches, + fix a bug that prevented annex.thin from taking effect for the files + in working tree. + * Avoid making a commit when upgrading from direct mode to v7. + * init: Catch more exceptions when testing locking. + * init: Fix a reversion that broke initialization on systems that + need to use pid locking. + * A git-annex-standalone rpm is now distributed along with the standalone + tarball. + * Added standalone/rpm/rpmbuild-from-standalone-tarball script. + + -- Joey Hess Fri, 13 Sep 2019 12:53:06 -0400 + git-annex (7.20190819) upstream; urgency=medium * New git-lfs special remote, which can be used to store data on any git-lfs diff --git a/CmdLine/Seek.hs b/CmdLine/Seek.hs --- a/CmdLine/Seek.hs +++ b/CmdLine/Seek.hs @@ -114,38 +114,21 @@ 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.hs b/Command.hs --- a/Command.hs +++ b/Command.hs @@ -24,7 +24,6 @@ import Options.Applicative as ReExported hiding (command) import qualified Git import Annex.Init -import Config import Utility.Daemon import Types.Transfer import Types.ActionItem @@ -119,10 +118,6 @@ repoExists :: CommandCheck repoExists = CommandCheck 0 ensureInitialized - -notDirect :: Command -> Command -notDirect = addCheck $ whenM isDirect $ - giveup "You cannot run this command in a direct mode repository." notBareRepo :: Command -> Command notBareRepo = addCheck $ whenM (fromRepo Git.repoIsLocalBare) $ diff --git a/Command/Add.hs b/Command/Add.hs --- a/Command/Add.hs +++ b/Command/Add.hs @@ -11,14 +11,11 @@ import Annex.Ingest import Logs.Location import Annex.Content -import Annex.Content.Direct import qualified Annex import qualified Annex.Queue import qualified Database.Keys -import Config import Annex.FileMatcher import Annex.Link -import Annex.Version import Annex.Tmp import Messages.Progress import Git.FilePath @@ -71,11 +68,7 @@ unless (updateOnly o) $ go (withFilesNotInGit (not $ includeDotFiles o)) go withFilesMaybeModified - ifM versionSupportsUnlockedPointers - ( go withUnmodifiedUnlockedPointers - , unlessM isDirect $ - go withFilesOldUnlocked - ) + go withUnmodifiedUnlockedPointers {- Pass file off to git-add. -} startSmall :: FilePath -> CommandStart @@ -95,12 +88,8 @@ 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 @@ -112,18 +101,10 @@ 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 - , ifM isDirect - ( liftIO (catchMaybeIO $ getSymbolicLinkStatus file) >>= \case - Just s | isSymbolicLink s -> fixuplink key - _ -> ifM (goodContent key file) - ( stop , 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/AddUnused.hs b/Command/AddUnused.hs --- a/Command/AddUnused.hs +++ b/Command/AddUnused.hs @@ -13,10 +13,9 @@ import Command.Unused (withUnusedMaps, UnusedMaps(..), startUnused) cmd :: Command -cmd = notDirect $ - command "addunused" SectionMaintenance - "add back unused files" - (paramRepeating paramNumRange) (withParams seek) +cmd = command "addunused" SectionMaintenance + "add back unused files" + (paramRepeating paramNumRange) (withParams seek) seek :: CmdParams -> CommandSeek seek = withUnusedMaps start diff --git a/Command/Adjust.hs b/Command/Adjust.hs --- a/Command/Adjust.hs +++ b/Command/Adjust.hs @@ -11,7 +11,7 @@ import Annex.AdjustedBranch cmd :: Command -cmd = notBareRepo $ notDirect $ noDaemonRunning $ +cmd = notBareRepo $ noDaemonRunning $ command "adjust" SectionSetup "enter adjusted branch" paramNothing (seek <$$> optParser) diff --git a/Command/DiffDriver.hs b/Command/DiffDriver.hs --- a/Command/DiffDriver.hs +++ b/Command/DiffDriver.hs @@ -90,12 +90,7 @@ v <- getAnnexLinkTarget' (getfile r) False case parseLinkTargetOrPointer =<< v of Nothing -> return r - Just k -> setfile r <$> - withObjectLoc k - -- indirect mode - return - -- direct mode - (return . Prelude.head) + Just k -> withObjectLoc k (pure . setfile r) _ -> return r externalDiffer :: String -> [String] -> Differ diff --git a/Command/Direct.hs b/Command/Direct.hs --- a/Command/Direct.hs +++ b/Command/Direct.hs @@ -8,60 +8,14 @@ module Command.Direct where import Command -import qualified Git -import qualified Git.LsFiles -import qualified Git.Branch -import Config -import Annex.Direct -import Annex.Version cmd :: Command cmd = notBareRepo $ noDaemonRunning $ - command "direct" SectionSetup "switch repository to direct mode" + command "direct" SectionSetup "switch repository to direct mode (deprecated)" paramNothing (withParams seek) seek :: CmdParams -> CommandSeek seek = withNothing (commandAction start) start :: CommandStart -start = ifM versionSupportsDirectMode - ( ifM isDirect - ( stop - , starting "direct" (ActionItemOther Nothing) - perform - ) - , giveup "Direct mode is not supported by this repository version. Use git-annex unlock instead." - ) - -perform :: CommandPerform -perform = do - showOutput - _ <- inRepo $ Git.Branch.commitCommand Git.Branch.ManualCommit - [ Param "-a" - , Param "-m" - , Param "commit before switching to direct mode" - ] - - top <- fromRepo Git.repoPath - (l, clean) <- inRepo $ Git.LsFiles.inRepo [top] - forM_ l go - void $ liftIO clean - next cleanup - where - go = whenAnnexed $ \f k -> do - toDirectGen k f >>= \case - Nothing -> noop - Just a -> tryNonAsync a >>= \case - Left e -> warnlocked f e - Right _ -> return () - return Nothing - - warnlocked :: FilePath -> SomeException -> Annex () - warnlocked f e = do - warning $ f ++ ": " ++ show e - warning "leaving this file as-is; correct this problem and run git annex fsck on it" - -cleanup :: CommandCleanup -cleanup = do - setDirect True - return True +start = giveup "Direct mode is not supported by this repository version. Use git-annex unlock instead." diff --git a/Command/EnableTor.hs b/Command/EnableTor.hs --- a/Command/EnableTor.hs +++ b/Command/EnableTor.hs @@ -41,7 +41,11 @@ -- This runs as root, so avoid making any commits or initializing -- git-annex, or doing other things that create root-owned files. start :: [String] -> CommandStart +#ifndef mingw32_HOST_OS start os = do +#else +start _os = do +#endif uuid <- getUUID when (uuid == NoUUID) $ giveup "This can only be run in a git-annex repository." diff --git a/Command/Fix.hs b/Command/Fix.hs --- a/Command/Fix.hs +++ b/Command/Fix.hs @@ -12,7 +12,6 @@ import Command import Config import qualified Annex -import Annex.Version import Annex.ReplaceFile import Annex.Content import Annex.Perms @@ -25,19 +24,15 @@ #endif cmd :: Command -cmd = notDirect $ noCommit $ withGlobalOptions [annexedMatchingOptions] $ +cmd = noCommit $ withGlobalOptions [annexedMatchingOptions] $ command "fix" SectionMaintenance "fix up links to annexed content" paramPaths (withParams seek) 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/FromKey.hs b/Command/FromKey.hs --- a/Command/FromKey.hs +++ b/Command/FromKey.hs @@ -19,7 +19,7 @@ import Network.URI cmd :: Command -cmd = notDirect $ notBareRepo $ withGlobalOptions [jsonOptions] $ +cmd = notBareRepo $ withGlobalOptions [jsonOptions] $ command "fromkey" SectionPlumbing "adds a file using a specific key" (paramRepeating (paramPair paramKey paramPath)) (seek <$$> optParser) diff --git a/Command/Fsck.hs b/Command/Fsck.hs --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -15,8 +15,6 @@ import qualified Types.Backend import qualified Backend import Annex.Content -import qualified Annex.Content.Direct as Direct -import Annex.Direct import Annex.Perms import Annex.Link import Logs.Location @@ -28,7 +26,6 @@ import Annex.UUID import Annex.ReplaceFile import Utility.DataUnits -import Config import Utility.HumanTime import Utility.CopyFile import Git.FilePath @@ -225,16 +222,15 @@ - in this repository only. -} verifyLocationLog :: Key -> KeyStatus -> ActionItem -> Annex Bool verifyLocationLog key keystatus ai = do - direct <- isDirect obj <- calcRepo $ gitAnnexLocation key - present <- if not direct && isKeyUnlockedThin keystatus + present <- if isKeyUnlockedThin keystatus then liftIO (doesFileExist obj) else inAnnex key u <- getUUID {- Since we're checking that a key's object file is present, throw - in a permission fixup here too. -} - when (present && not direct) $ do + when present $ do void $ tryIO $ case keystatus of KeyUnlockedThin -> thawContent obj KeyLockedThin -> thawContent obj @@ -252,11 +248,7 @@ whenM (annexSecureHashesOnly <$> Annex.getGitConfig) $ warning $ "** Despite annex.securehashesonly being set, " ++ obj ++ " has content present in the annex using an insecure " ++ decodeBS (formatKeyVariety (keyVariety key)) ++ " key" - {- In direct mode, modified files will show up as not present, - - but that is expected and not something to do anything about. -} - if direct && not present - then return True - else verifyLocationLog' key ai present u (logChange key u) + verifyLocationLog' key ai present u (logChange key u) verifyLocationLogRemote :: Key -> ActionItem -> Remote -> Bool -> Annex Bool verifyLocationLogRemote key ai remote present = @@ -319,56 +311,38 @@ {- Verifies the associated file records. -} verifyAssociatedFiles :: Key -> KeyStatus -> FilePath -> Annex Bool verifyAssociatedFiles key keystatus file = do - ifM isDirect (godirect, goindirect) - return True - where - godirect = do - fs <- Direct.addAssociatedFile key file - forM_ fs $ \f -> - unlessM (liftIO $ doesFileExist f) $ - void $ Direct.removeAssociatedFile key f - goindirect = when (isKeyUnlockedThin keystatus) $ do + when (isKeyUnlockedThin keystatus) $ do f <- inRepo $ toTopFilePath file afs <- Database.Keys.getAssociatedFiles key unless (getTopFilePath f `elem` map getTopFilePath afs) $ Database.Keys.addAssociatedFile key f + return True verifyWorkTree :: Key -> FilePath -> Annex Bool verifyWorkTree key file = do - ifM isDirect ( godirect, goindirect ) - return True - where - {- Ensures that files whose content is available are in direct mode. -} - godirect = whenM (isJust <$> isAnnexLink file) $ do - v <- toDirectGen key file - case v of - Nothing -> noop - Just a -> do - showNote "fixing direct mode" - a {- Make sure that a pointer file is replaced with its content, - when the content is available. -} - goindirect = do - mk <- liftIO $ isPointerFile file - case mk of - Just k | k == key -> whenM (inAnnex key) $ do - showNote "fixing worktree content" - replaceFile file $ \tmp -> do - mode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus file - ifM (annexThin <$> Annex.getGitConfig) - ( void $ linkFromAnnex key tmp mode - , do - obj <- calcRepo $ gitAnnexLocation key - void $ checkedCopyFile key obj tmp mode - thawContent tmp - ) - Database.Keys.storeInodeCaches key [file] - _ -> return () + mk <- liftIO $ isPointerFile file + case mk of + Just k | k == key -> whenM (inAnnex key) $ do + showNote "fixing worktree content" + replaceFile file $ \tmp -> do + mode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus file + ifM (annexThin <$> Annex.getGitConfig) + ( void $ linkFromAnnex key tmp mode + , do + obj <- calcRepo $ gitAnnexLocation key + void $ checkedCopyFile key obj tmp mode + thawContent tmp + ) + Database.Keys.storeInodeCaches key [file] + _ -> return () + return True {- The size of the data for a key is checked against the size encoded in - the key's metadata, if available. - - - Not checked when a file is unlocked, or in direct mode. + - Not checked when a file is unlocked. -} checkKeySize :: Key -> KeyStatus -> ActionItem -> Annex Bool checkKeySize _ KeyUnlockedThin _ = return True @@ -439,28 +413,15 @@ - thus when the user modifies the file, the object will be modified and - not pass the check, and we don't want to find an error in this case. - So, skip the check if the key is unlocked and modified. - - - - In direct mode this is not done if the file has clearly been modified, - - because modification of direct mode files is allowed. It's still done - - if the file does not appear modified, to catch disk corruption, etc. -} checkBackend :: Backend -> Key -> KeyStatus -> AssociatedFile -> Annex Bool -checkBackend backend key keystatus afile = go =<< isDirect - where - go False = do - content <- calcRepo $ gitAnnexLocation key - ifM (pure (isKeyUnlockedThin keystatus) <&&> (not <$> isUnmodified key content)) - ( nocheck - , checkBackendOr badContent backend key content ai - ) - go True = case afile of - AssociatedFile Nothing -> nocheck - AssociatedFile (Just f) -> checkdirect f - checkdirect file = ifM (Direct.goodContent key file) - ( checkBackendOr' (badContentDirect file) backend key file ai - (Direct.goodContent key file) - , nocheck +checkBackend backend key keystatus afile = do + content <- calcRepo $ gitAnnexLocation key + ifM (pure (isKeyUnlockedThin keystatus) <&&> (not <$> isUnmodified key content)) + ( nocheck + , checkBackendOr badContent backend key content ai ) + where nocheck = return True ai = mkActionItem (key, afile) @@ -475,7 +436,7 @@ -- The postcheck action is run after the content is verified, -- in order to detect situations where the file is changed while being --- verified (particularly in direct mode). +-- verified. checkBackendOr' :: (Key -> Annex String) -> Backend -> Key -> FilePath -> ActionItem -> Annex Bool -> Annex Bool checkBackendOr' bad backend key file ai postcheck = case Types.Backend.verifyKeyContent backend of @@ -546,14 +507,6 @@ dest <- moveBad key return $ "moved to " ++ dest -{- Bad content is left where it is, but we touch the file, so it'll be - - committed to a new key. -} -badContentDirect :: FilePath -> Key -> Annex String -badContentDirect file key = do - void $ liftIO $ catchMaybeIO $ touchFile file - logStatus key InfoMissing - return "left in place for you to examine" - {- Bad content is dropped from the remote. We have downloaded a copy - from the remote to a temp file already (in some cases, it's just a - symlink to a file in the remote). To avoid any further data loss, @@ -714,16 +667,13 @@ isKeyUnlockedThin KeyMissing = False getKeyStatus :: Key -> Annex KeyStatus -getKeyStatus key = ifM isDirect - ( return KeyUnlockedThin - , catchDefaultIO KeyMissing $ do - afs <- not . null <$> Database.Keys.getAssociatedFiles key - obj <- calcRepo $ gitAnnexLocation key - multilink <- ((> 1) . linkCount <$> liftIO (getFileStatus obj)) - return $ if multilink && afs - then KeyUnlockedThin - else KeyPresent - ) +getKeyStatus key = catchDefaultIO KeyMissing $ do + afs <- not . null <$> Database.Keys.getAssociatedFiles key + obj <- calcRepo $ gitAnnexLocation key + multilink <- ((> 1) . linkCount <$> liftIO (getFileStatus obj)) + return $ if multilink && afs + then KeyUnlockedThin + else KeyPresent getKeyFileStatus :: Key -> FilePath -> Annex KeyStatus getKeyFileStatus key file = do diff --git a/Command/FuzzTest.hs b/Command/FuzzTest.hs --- a/Command/FuzzTest.hs +++ b/Command/FuzzTest.hs @@ -155,7 +155,6 @@ = FuzzAdd FuzzFile | FuzzDelete FuzzFile | FuzzMove FuzzFile FuzzFile - | FuzzModify FuzzFile | FuzzDeleteDir FuzzDir | FuzzMoveDir FuzzDir FuzzDir | FuzzPause Delay @@ -166,7 +165,6 @@ [ (50, FuzzAdd <$> arbitrary) , (50, FuzzDelete <$> arbitrary) , (10, FuzzMove <$> arbitrary <*> arbitrary) - , (10, FuzzModify <$> arbitrary) , (10, FuzzDeleteDir <$> arbitrary) , (10, FuzzMoveDir <$> arbitrary <*> arbitrary) , (10, FuzzPause <$> arbitrary) @@ -180,9 +178,6 @@ runFuzzAction (FuzzDelete (FuzzFile f)) = liftIO $ nukeFile f runFuzzAction (FuzzMove (FuzzFile src) (FuzzFile dest)) = liftIO $ rename src dest -runFuzzAction (FuzzModify (FuzzFile f)) = whenM isDirect $ liftIO $ do - n <- getStdRandom random :: IO Int - appendFile f $ show n ++ "\n" runFuzzAction (FuzzDeleteDir (FuzzDir d)) = liftIO $ removeDirectoryRecursive d runFuzzAction (FuzzMoveDir (FuzzDir src) (FuzzDir dest)) = liftIO $ @@ -216,9 +211,6 @@ FuzzDeleteDir _ -> do d <- liftIO existingDir maybe genFuzzAction (return . FuzzDeleteDir) d - FuzzModify _ -> do - f <- liftIO $ existingFile 0 "" - maybe genFuzzAction (return . FuzzModify) f FuzzPause _ -> return tmpl existingFile :: Int -> FilePath -> IO (Maybe FuzzFile) diff --git a/Command/Indirect.hs b/Command/Indirect.hs --- a/Command/Indirect.hs +++ b/Command/Indirect.hs @@ -8,89 +8,14 @@ module Command.Indirect where import Command -import qualified Git -import qualified Git.Branch -import qualified Git.LsFiles -import Git.FileMode -import Config -import qualified Annex -import Annex.Direct -import Annex.Content -import Annex.Content.Direct -import Annex.CatFile -import Annex.Init -import Annex.Ingest cmd :: Command cmd = notBareRepo $ noDaemonRunning $ - command "indirect" SectionSetup "switch repository to indirect mode" + command "indirect" SectionSetup "switch repository to indirect mode (deprecated)" paramNothing (withParams seek) seek :: CmdParams -> CommandSeek seek = withNothing (commandAction start) start :: CommandStart -start = ifM isDirect - ( do - unlessM (coreSymlinks <$> Annex.getGitConfig) $ - giveup "Git is configured to not use symlinks, so you must use direct mode." - whenM probeCrippledFileSystem $ - giveup "This repository seems to be on a crippled filesystem, you must use direct mode." - starting "indirect" (ActionItemOther Nothing) - perform - , stop - ) - -perform :: CommandPerform -perform = do - whenM stageDirect $ do - showOutput - void $ inRepo $ Git.Branch.commitCommand Git.Branch.ManualCommit - [ Param "-m" - , Param "commit before switching to indirect mode" - ] - - -- Note that we set indirect mode early, so that we can use - -- moveAnnex in indirect mode. - setDirect False - - top <- fromRepo Git.repoPath - (l, clean) <- inRepo $ Git.LsFiles.stagedOthersDetails [top] - forM_ l go - void $ liftIO clean - next $ return True - where - {- Walk tree from top and move all present direct mode files into - - the annex, replacing with symlinks. Also delete direct mode - - caches and mappings. -} - go (f, Just sha, Just mode) | isSymLink mode = do - r <- liftIO $ catchMaybeIO $ getSymbolicLinkStatus f - case r of - Just s - | isSymbolicLink s -> void $ flip whenAnnexed f $ - \_ k -> do - removeInodeCache k - removeAssociatedFiles k - return Nothing - | otherwise -> - maybe noop (fromdirect f) - =<< catKey sha - _ -> noop - go _ = noop - - fromdirect f k = do - removeInodeCache k - removeAssociatedFiles k - whenM (liftIO $ not . isSymbolicLink <$> getSymbolicLinkStatus f) $ do - v <- tryNonAsync (moveAnnex k f) - case v of - Right True -> do - l <- calcRepo $ gitAnnexLink f k - liftIO $ createSymbolicLink l f - Right False -> warnlocked "Failed to move file to annex" - Left e -> catchNonAsync (restoreFile f k e) $ - warnlocked . show - - warnlocked msg = do - warning msg - warning "leaving this file as-is; correct this problem and run git annex add on it" +start = stop diff --git a/Command/Info.hs b/Command/Info.hs --- a/Command/Info.hs +++ b/Command/Info.hs @@ -31,7 +31,6 @@ import Logs.Location import Annex.NumCopies import Remote -import Config import Git.Config (boolConfig) import qualified Git.LsTree as LsTree import Utility.Percentage @@ -132,6 +131,7 @@ globalInfo :: InfoOptions -> Annex () globalInfo o = do + disallowMatchingOptions u <- getUUID whenM ((==) DeadTrusted <$> lookupTrust u) $ earlyWarning "Warning: This repository is currently marked as dead." @@ -144,6 +144,7 @@ itemInfo o p = ifM (isdir p) ( dirInfo o p , do + disallowMatchingOptions v <- Remote.byName' p case v of Right r -> remoteInfo o r @@ -164,6 +165,10 @@ showNote $ "not a directory or an annexed file or a treeish or a remote or a uuid" showEndFail +disallowMatchingOptions :: Annex () +disallowMatchingOptions = whenM Limit.limited $ + giveup "File matching options can only be used when getting info on a directory." + dirInfo :: InfoOptions -> FilePath -> Annex () dirInfo o dir = showCustom (unwords ["info", dir]) $ do stats <- selStats @@ -221,8 +226,7 @@ -} global_fast_stats :: [Stat] global_fast_stats = - [ repository_mode - , repo_list Trusted + [ repo_list Trusted , repo_list SemiTrusted , repo_list UnTrusted , transfer_list @@ -267,7 +271,6 @@ remote_fast_stats :: Remote -> [Stat] remote_fast_stats r = map (\s -> s r) [ remote_name - , remote_trust , remote_cost , remote_type ] @@ -276,6 +279,7 @@ uuid_fast_stats u = map (\s -> s u) [ repo_uuid , repo_description + , repo_trust ] uuid_slow_stats :: UUID -> [Stat] @@ -310,16 +314,6 @@ (lift . showHeader) desc lift . showRaw =<< a -repository_mode :: Stat -repository_mode = simpleStat "repository mode" $ lift $ - ifM isDirect - ( return "direct" - , ifM (fromRepo Git.repoIsLocalBare) - ( return "bare" - , return "indirect" - ) - ) - repo_list :: TrustLevel -> Stat repo_list level = stat n $ nojson $ lift $ do us <- filter (/= NoUUID) . M.keys @@ -353,9 +347,8 @@ repo_uuid :: UUID -> Stat repo_uuid = simpleStat "uuid" . pure . fromUUID -remote_trust :: Remote -> Stat -remote_trust r = simpleStat "trust" $ lift $ - showTrustLevel <$> lookupTrust (Remote.uuid r) +repo_trust :: UUID -> Stat +repo_trust u = simpleStat "trust" $ lift $ showTrustLevel <$> lookupTrust u remote_cost :: Remote -> Stat remote_cost r = simpleStat "cost" $ pure $ @@ -525,7 +518,7 @@ case presentData s of Just v -> return v Nothing -> do - v <- foldKeys <$> lift (getKeysPresent InRepository) + v <- foldKeys <$> lift (listKeys InAnnex) put s { presentData = Just v } return v diff --git a/Command/Lock.hs b/Command/Lock.hs --- a/Command/Lock.hs +++ b/Command/Lock.hs @@ -10,7 +10,6 @@ import Command import qualified Annex.Queue import qualified Annex -import Annex.Version import Annex.Content import Annex.Link import Annex.InodeSentinal @@ -23,7 +22,7 @@ import Git.FilePath cmd :: Command -cmd = notDirect $ withGlobalOptions [jsonOptions, annexedMatchingOptions] $ +cmd = withGlobalOptions [jsonOptions, annexedMatchingOptions] $ command "lock" SectionCommon "undo unlock command" paramPaths (withParams seek) @@ -31,12 +30,7 @@ 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/Migrate.hs b/Command/Migrate.hs --- a/Command/Migrate.hs +++ b/Command/Migrate.hs @@ -20,7 +20,7 @@ import Utility.Metered cmd :: Command -cmd = notDirect $ withGlobalOptions [annexedMatchingOptions] $ +cmd = withGlobalOptions [annexedMatchingOptions] $ command "migrate" SectionUtility "switch data to different backend" paramPaths (withParams seek) diff --git a/Command/Multicast.hs b/Command/Multicast.hs --- a/Command/Multicast.hs +++ b/Command/Multicast.hs @@ -27,7 +27,6 @@ import Utility.Tmp import Utility.Tmp.Dir import Utility.Process.Transcript -import Config import Data.Char import qualified Data.ByteString.Lazy.UTF8 as B8 @@ -128,8 +127,6 @@ -- In a direct mode repository, the annex objects do not have -- the names of keys, and would have to be copied, which is too -- expensive. - whenM isDirect $ - giveup "Sorry, multicast send cannot be done from a direct mode repository." starting "sending files" (ActionItemOther Nothing) $ withTmpFile "send" $ \t h -> do fs' <- seekHelper LsFiles.inRepo =<< workTreeItems fs @@ -140,7 +137,7 @@ mk <- lookupFile f case mk of Nothing -> noop - Just k -> withObjectLoc k (addlist f) (const noop) + Just k -> withObjectLoc k (addlist f) liftIO $ hClose h serverkey <- uftpKey diff --git a/Command/PreCommit.hs b/Command/PreCommit.hs --- a/Command/PreCommit.hs +++ b/Command/PreCommit.hs @@ -10,23 +10,17 @@ module Command.PreCommit where import Command -import Config -import qualified Command.Add import qualified Command.Fix import qualified Command.Smudge -import Annex.Direct 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 @@ -38,60 +32,25 @@ (withParams seek) seek :: CmdParams -> CommandSeek -seek ps = lockPreCommitHook $ ifM isDirect - ( do - -- update direct mode mappings for committed files - withWords (commandAction . startDirect) ps - runAnnexHook preCommitAnnexHook - , 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 - -- When there's a false index, - -- restaging the files won't work. - . Restage =<< liftIO Git.haveFalseIndex - -- inject unlocked files into the annex - -- (not needed when repo version uses - -- unlocked pointer files) - , withFilesOldUnlockedToBeCommitted (commandAction . startInjectUnlocked) l - ) - ) - runAnnexHook preCommitAnnexHook - -- committing changes to a view updates metadata - mv <- currentView - case mv of - Nothing -> noop - Just v -> withViewChanges - (addViewMetaData v) - (removeViewMetaData v) - ) +seek ps = lockPreCommitHook $ 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 + -- 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) - -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 + runAnnexHook preCommitAnnexHook -startDirect :: [String] -> CommandStart -startDirect _ = startingCustomOutput (ActionItemOther Nothing) $ - next preCommitDirect + -- committing changes to a view updates metadata + mv <- currentView + case mv of + Nothing -> noop + Just v -> withViewChanges + (addViewMetaData v) + (removeViewMetaData v) addViewMetaData :: View -> ViewedFile -> Key -> CommandStart addViewMetaData v f k = starting "metadata" (mkActionItem (k, f)) $ diff --git a/Command/Proxy.hs b/Command/Proxy.hs --- a/Command/Proxy.hs +++ b/Command/Proxy.hs @@ -8,23 +8,11 @@ module Command.Proxy where import Command -import Config -import Utility.Tmp.Dir -import Utility.Env -import Annex.Direct -import Annex.Tmp -import qualified Git -import qualified Git.Sha -import qualified Git.Ref -import qualified Git.Branch -import qualified Git.LsFiles -import Git.FilePath -import Utility.CopyFile cmd :: Command cmd = notBareRepo $ command "proxy" SectionPlumbing - "safely bypass direct mode guard" + "safely bypass direct mode guard (deprecated)" ("-- git command") (withParams seek) seek :: CmdParams -> CommandSeek @@ -32,48 +20,4 @@ start :: [String] -> CommandStart start [] = giveup "Did not specify command to run." -start (c:ps) = liftIO . exitWith =<< ifM isDirect - ( withOtherTmp $ \tmp -> withTmpDirIn tmp "proxy" go - , liftIO $ safeSystem c (map Param ps) - ) - where - go tmp = do - oldref <- fromMaybe Git.Sha.emptyTree - <$> (inRepo . maybe Git.Ref.headSha Git.Ref.sha - =<< inRepo Git.Branch.currentUnsafe) - - exitcode <- proxy tmp - - cleanupproxy tmp oldref - - return exitcode - - proxy tmp = do - usetmp <- liftIO $ Just . addEntry "GIT_WORK_TREE" tmp <$> getEnvironment - - -- Set up the tmp work tree, to contain both a checkout of all - -- staged files as well as hard links (or copies) of any - -- unstaged files. - unlessM (isNothing <$> inRepo Git.Branch.current) $ - unlessM (liftIO $ boolSystemEnv "git" [Param "checkout", Param "--", Param "."] usetmp) $ - error "Failed to set up proxy work tree." - top <- fromRepo Git.repoPath - (fs, cleanup) <- inRepo $ Git.LsFiles.notInRepo True [top] - forM_ fs $ \f -> do - tf <- inRepo $ toTopFilePath f - let tmpf = tmp getTopFilePath tf - liftIO $ do - createDirectoryIfMissing True (takeDirectory tmpf) - createLinkOrCopy f tmpf - liftIO $ void cleanup - - liftIO $ safeSystemEnv c (map Param ps) usetmp - - -- To merge the changes made by the proxied command into - -- the work tree is similar to cleaning up after a - -- direct mode merge. But, here we force updates of any - -- non-annxed files that were changed by the proxied - -- command. - cleanupproxy tmp oldref = do - updateWorkTree tmp oldref True - liftIO $ removeDirectoryRecursive tmp +start (c:ps) = liftIO $ exitWith =<< safeSystem c (map Param ps) diff --git a/Command/ReKey.hs b/Command/ReKey.hs --- a/Command/ReKey.hs +++ b/Command/ReKey.hs @@ -21,11 +21,10 @@ import Utility.InodeCache cmd :: Command -cmd = notDirect $ - command "rekey" SectionPlumbing - "change keys used for files" - (paramRepeating $ paramPair paramPath paramKey) - (seek <$$> optParser) +cmd = command "rekey" SectionPlumbing + "change keys used for files" + (paramRepeating $ paramPair paramPath paramKey) + (seek <$$> optParser) data ReKeyOptions = ReKeyOptions { reKeyThese :: CmdParams diff --git a/Command/RegisterUrl.hs b/Command/RegisterUrl.hs --- a/Command/RegisterUrl.hs +++ b/Command/RegisterUrl.hs @@ -15,7 +15,7 @@ import qualified Remote cmd :: Command -cmd = notDirect $ notBareRepo $ +cmd = notBareRepo $ command "registerurl" SectionPlumbing "registers an url for a key" (paramPair paramKey paramUrl) diff --git a/Command/Status.hs b/Command/Status.hs --- a/Command/Status.hs +++ b/Command/Status.hs @@ -8,11 +8,7 @@ module Command.Status where import Command -import Annex.CatFile -import Annex.Content.Direct -import Config import Git.Status -import qualified Git.Ref import Git.FilePath cmd :: Command @@ -42,10 +38,7 @@ start :: StatusOptions -> [FilePath] -> CommandStart start o locs = do (l, cleanup) <- inRepo $ getStatus ps locs - getstatus <- ifM isDirect - ( return (maybe (pure Nothing) statusDirect . simplifiedStatus) - , return (pure . simplifiedStatus) - ) + let getstatus = pure . simplifiedStatus forM_ l $ \s -> maybe noop displayStatus =<< getstatus s ifM (liftIO cleanup) ( stop @@ -71,38 +64,3 @@ f <- liftIO $ relPathCwdToFile absf unlessM (showFullJSON $ JSONChunk [("status", [c]), ("file", f)]) $ liftIO $ putStrLn $ [c] ++ " " ++ f - --- Git thinks that present direct mode files are typechanged. --- (On crippled filesystems, git instead thinks they're modified.) --- Check their content to see if they are modified or not. -statusDirect :: Status -> Annex (Maybe Status) -statusDirect (TypeChanged t) = statusDirect' t -statusDirect s@(Modified t) = ifM crippledFileSystem - ( statusDirect' t - , pure (Just s) - ) -statusDirect s = pure (Just s) - -statusDirect' :: TopFilePath -> Annex (Maybe Status) -statusDirect' t = do - absf <- fromRepo $ fromTopFilePath t - f <- liftIO $ relPathCwdToFile absf - v <- liftIO (catchMaybeIO $ getFileStatus f) - case v of - Nothing -> return $ Just $ Deleted t - Just s - | not (isSymbolicLink s) -> - checkkey f s =<< catKeyFile f - | otherwise -> Just <$> checkNew f t - where - checkkey f s (Just k) = ifM (sameFileStatus k f s) - ( return Nothing - , return $ Just $ Modified t - ) - checkkey f _ Nothing = Just <$> checkNew f t - -checkNew :: FilePath -> TopFilePath -> Annex Status -checkNew f t = ifM (isJust <$> catObjectDetails (Git.Ref.fileRef f)) - ( return (Modified t) - , return (Untracked t) - ) diff --git a/Command/Sync.hs b/Command/Sync.hs --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -30,7 +30,6 @@ import qualified Annex.Branch import qualified Remote import qualified Types.Remote as Remote -import Annex.Direct import Annex.Hook import qualified Git.Command import qualified Git.LsFiles as LsFiles @@ -250,7 +249,7 @@ ResolveMergeOverride False -> return False syncBranch :: Git.Branch -> Git.Branch -syncBranch = Git.Ref.underBase "refs/heads/synced" . fromDirectBranch . fromAdjustedBranch +syncBranch = Git.Ref.underBase "refs/heads/synced" . fromAdjustedBranch remoteBranch :: Remote -> Git.Ref -> Git.Ref remoteBranch remote = Git.Ref.underBase $ "refs/remotes/" ++ Remote.name remote @@ -286,20 +285,14 @@ commit o = stopUnless shouldcommit $ starting "commit" (ActionItemOther Nothing) $ do commitmessage <- maybe commitMsg return (messageOption o) Annex.Branch.commit =<< Annex.Branch.commitMessage - next $ ifM isDirect - ( do - void stageDirect - void preCommitDirect - commitStaged Git.Branch.ManualCommit commitmessage - , do - showOutput - void $ inRepo $ Git.Branch.commitCommand Git.Branch.ManualCommit - [ Param "-a" - , Param "-m" - , Param commitmessage - ] - return True - ) + next $ do + showOutput + void $ inRepo $ Git.Branch.commitCommand Git.Branch.ManualCommit + [ Param "-a" + , Param "-m" + , Param commitmessage + ] + return True where shouldcommit = pure (commitOption o) <||> (pure (not (noCommitOption o)) <&&> getGitConfigVal annexAutoCommit) @@ -378,12 +371,6 @@ -- Update the sync branch to match the new state of the branch inRepo $ updateBranch (syncBranch branch) branch - -- In direct mode, we're operating on some special direct mode - -- branch, rather than the intended branch, so update the intended - -- branch. - whenM isDirect $ - inRepo $ updateBranch (fromDirectBranch branch) branch - updateBranch :: Git.Branch -> Git.Branch -> Git.Repo -> IO () updateBranch syncbranch updateto g = unlessM go $ giveup $ "failed to update " ++ Git.fromRef syncbranch @@ -449,7 +436,7 @@ (mapM (merge currbranch mergeconfig resolvemergeoverride Git.Branch.ManualCommit . remoteBranch remote) =<< getlist) tomerge = filterM (changed remote) branchlist Nothing = [] - branchlist (Just branch) = [fromDirectBranch (fromAdjustedBranch branch), syncBranch branch] + branchlist (Just branch) = [fromAdjustedBranch branch, syncBranch branch] pushRemote :: SyncOptions -> Remote -> CurrBranch -> CommandStart pushRemote _o _remote (Nothing, _) = stop @@ -471,8 +458,9 @@ | 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 @@ -540,7 +528,7 @@ -- receive.denyCurrentBranch=updateInstead -- the user -- will want to see that one. let p = flip Git.Command.gitCreateProcess g $ pushparams - [ Git.fromRef $ Git.Ref.base $ fromDirectBranch $ fromAdjustedBranch branch ] + [ Git.fromRef $ Git.Ref.base $ fromAdjustedBranch branch ] (transcript, ok) <- processTranscript' p Nothing when (not ok && not ("denyCurrentBranch" `isInfixOf` transcript)) $ hPutStr stderr transcript diff --git a/Command/Unannex.hs b/Command/Unannex.hs --- a/Command/Unannex.hs +++ b/Command/Unannex.hs @@ -8,18 +8,11 @@ module Command.Unannex where import Command -import Config import qualified Annex import Annex.Content import Annex.Perms -import Annex.Content.Direct -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 @@ -30,51 +23,15 @@ paramPaths (withParams seek) seek :: CmdParams -> CommandSeek -seek ps = wrapUnannex $ - (withFilesInGit $ commandAction . whenAnnexed start) =<< workTreeItems ps - -wrapUnannex :: Annex a -> Annex a -wrapUnannex a = ifM (versionSupportsUnlockedPointers <||> isDirect) - ( 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, cleanup) <- inRepo $ DiffTree.diffIndex Git.Ref.headRef - if null diff - then void (liftIO cleanup) >> return True - else void (liftIO cleanup) >> return False - , return False - ) +seek ps = (withFilesInGit $ commandAction . whenAnnexed start) =<< workTreeItems ps start :: FilePath -> Key -> CommandStart start file key = stopUnless (inAnnex key) $ starting "unannex" (mkActionItem (key, file)) $ - ifM isDirect - ( performDirect file key - , performIndirect file key - ) + perform file key -performIndirect :: FilePath -> Key -> CommandPerform -performIndirect file key = do +perform :: FilePath -> Key -> CommandPerform +perform file key = do liftIO $ removeFile file inRepo $ Git.Command.run [ Param "rm" @@ -84,10 +41,10 @@ , Param "--" , File file ] - next $ cleanupIndirect file key + next $ cleanup file key -cleanupIndirect :: FilePath -> Key -> CommandCleanup -cleanupIndirect file key = do +cleanup :: FilePath -> Key -> CommandCleanup +cleanup file key = do Database.Keys.removeAssociatedFile key =<< inRepo (toTopFilePath file) src <- calcRepo $ gitAnnexLocation key ifM (Annex.getState Annex.fast) @@ -112,28 +69,3 @@ ( return True , copyfrom src ) - -performDirect :: FilePath -> Key -> CommandPerform -performDirect file key = do - -- --force is needed when the file is not committed - inRepo $ Git.Command.run - [ Param "rm" - , Param "--cached" - , Param "--force" - , Param "--quiet" - , Param "--" - , File file - ] - next $ cleanupDirect file key - -{- The direct mode file is not touched during unannex, so the content - - is already where it needs to be, so this does not need to do anything - - except remove it from the associated file map (which also updates - - the location log if this was the last copy), and, if this was the last - - associated file, remove the inode cache. -} -cleanupDirect :: FilePath -> Key -> CommandCleanup -cleanupDirect file key = do - fs <- removeAssociatedFile key file - when (null fs) $ - removeInodeCache key - return True diff --git a/Command/Undo.hs b/Command/Undo.hs --- a/Command/Undo.hs +++ b/Command/Undo.hs @@ -8,9 +8,6 @@ module Command.Undo where import Command -import Config -import Annex.Direct -import Annex.CatFile import Git.DiffTree import Git.FilePath import Git.UpdateIndex @@ -37,9 +34,7 @@ -- Committing staged changes before undo allows later -- undoing the undo. It would be nicer to only commit staged - -- changes to the specified files, rather than all staged changes, - -- but that is difficult to do; a partial git-commit can't be done - -- in direct mode. + -- changes to the specified files, rather than all staged changes. void $ Command.Sync.commitStaged Git.Branch.ManualCommit "commit before undo" @@ -68,16 +63,10 @@ forM_ removals $ \di -> do f <- mkrel di - whenM isDirect $ - maybe noop (`removeDirect` f) - =<< catKey (srcsha di) liftIO $ nukeFile f forM_ adds $ \di -> do f <- mkrel di inRepo $ Git.run [Param "checkout", Param "--", File f] - whenM isDirect $ - maybe noop (`toDirect` f) - =<< catKey (dstsha di) next $ liftIO cleanup diff --git a/Command/Uninit.hs b/Command/Uninit.hs --- a/Command/Uninit.hs +++ b/Command/Uninit.hs @@ -59,7 +59,7 @@ finish = do annexdir <- fromRepo gitAnnexDir annexobjectdir <- fromRepo gitAnnexObjectDir - leftovers <- removeUnannexed =<< getKeysPresent InAnnex + leftovers <- removeUnannexed =<< listKeys InAnnex prepareRemoveAnnexDir annexdir if null leftovers then liftIO $ removeDirectoryRecursive annexdir diff --git a/Command/Unlock.hs b/Command/Unlock.hs --- a/Command/Unlock.hs +++ b/Command/Unlock.hs @@ -10,11 +10,8 @@ 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 @@ -25,9 +22,8 @@ editcmd = mkcmd "edit" "same as unlock" mkcmd :: String -> String -> Command -mkcmd n d = notDirect $ - withGlobalOptions [jsonOptions, annexedMatchingOptions] $ - command n SectionCommon d paramPaths (withParams seek) +mkcmd n d = withGlobalOptions [jsonOptions, annexedMatchingOptions] $ + command n SectionCommon d paramPaths (withParams seek) seek :: CmdParams -> CommandSeek seek ps = withFilesInGit (commandAction . whenAnnexed start) =<< workTreeItems ps @@ -38,15 +34,12 @@ 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) @@ -58,47 +51,10 @@ 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/Unused.hs b/Command/Unused.hs --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -84,9 +84,7 @@ return [] findunused False = do showAction "checking for unused data" - -- InAnnex, not InRepository because if a direct mode - -- file exists, it is obviously not unused. - excludeReferenced refspec =<< getKeysPresent InAnnex + excludeReferenced refspec =<< listKeys InAnnex chain _ [] = next $ return True chain v (a:as) = do v' <- a v diff --git a/Command/Upgrade.hs b/Command/Upgrade.hs --- a/Command/Upgrade.hs +++ b/Command/Upgrade.hs @@ -13,9 +13,13 @@ 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/Command/VAdd.hs b/Command/VAdd.hs --- a/Command/VAdd.hs +++ b/Command/VAdd.hs @@ -12,7 +12,7 @@ import Command.View (checkoutViewBranch) cmd :: Command -cmd = notBareRepo $ notDirect $ +cmd = notBareRepo $ command "vadd" SectionMetaData "add subdirs to current view" (paramRepeating "FIELD=GLOB") diff --git a/Command/VCycle.hs b/Command/VCycle.hs --- a/Command/VCycle.hs +++ b/Command/VCycle.hs @@ -14,7 +14,7 @@ import Command.View (checkoutViewBranch) cmd :: Command -cmd = notBareRepo $ notDirect $ +cmd = notBareRepo $ command "vcycle" SectionMetaData "switch view to next layout" paramNothing (withParams seek) diff --git a/Command/VFilter.hs b/Command/VFilter.hs --- a/Command/VFilter.hs +++ b/Command/VFilter.hs @@ -12,7 +12,7 @@ import Command.View (paramView, checkoutViewBranch) cmd :: Command -cmd = notBareRepo $ notDirect $ +cmd = notBareRepo $ command "vfilter" SectionMetaData "filter current view" paramView (withParams seek) diff --git a/Command/VPop.hs b/Command/VPop.hs --- a/Command/VPop.hs +++ b/Command/VPop.hs @@ -16,7 +16,7 @@ import Command.View (checkoutViewBranch) cmd :: Command -cmd = notBareRepo $ notDirect $ +cmd = notBareRepo $ command "vpop" SectionMetaData "switch back to previous view" paramNumber (withParams seek) diff --git a/Command/View.hs b/Command/View.hs --- a/Command/View.hs +++ b/Command/View.hs @@ -20,7 +20,7 @@ import Logs.View cmd :: Command -cmd = notBareRepo $ notDirect $ +cmd = notBareRepo $ command "view" SectionMetaData "enter a view branch" paramView (withParams seek) diff --git a/Database/Keys.hs b/Database/Keys.hs --- a/Database/Keys.hs +++ b/Database/Keys.hs @@ -29,7 +29,6 @@ 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 @@ 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 @@ - 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 --- a/Git/Branch.hs +++ b/Git/Branch.hs @@ -15,7 +15,6 @@ import Git.Command import qualified Git.Config import qualified Git.Ref -import qualified Git.BuildVersion {- The currently checked out branch. - @@ -125,8 +124,7 @@ {- 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 --- a/Git/CheckAttr.hs +++ b/Git/CheckAttr.hs @@ -10,12 +10,11 @@ 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 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 @@ [ 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 @@ 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 --- a/Git/CheckIgnore.hs +++ b/Git/CheckIgnore.hs @@ -15,7 +15,6 @@ 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 @@ - 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" @@ -51,11 +44,6 @@ repo' = repo { gitGlobalOpts = filter (not . pathspecs) (gitGlobalOpts repo) } 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. -} diff --git a/Git/Fsck.hs b/Git/Fsck.hs --- a/Git/Fsck.hs +++ b/Git/Fsck.hs @@ -22,7 +22,6 @@ 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 @@ -} 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 @@ , 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 @@ 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 @@ , 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 --- a/Git/Index.hs +++ b/Git/Index.hs @@ -58,19 +58,3 @@ {- 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 --- a/Git/Merge.hs +++ b/Git/Merge.hs @@ -17,7 +17,6 @@ import Common import Git import Git.Command -import qualified Git.BuildVersion import qualified Git.Version import Git.Branch (CommitMode(..)) @@ -33,7 +32,7 @@ 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 --- a/Git/Remote/Remove.hs +++ b/Git/Remote/Remove.hs @@ -13,17 +13,10 @@ 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/NEWS b/NEWS --- a/NEWS +++ b/NEWS @@ -1,3 +1,31 @@ +git-annex (7.20190912) upstream; urgency=medium + + This version of git-annex uses repository version 7 for all repositories. + + Existing v5 repositories will be automatically upgraded by default. + You can prevent this, by runing: git config annex.autoupgraderepository false + + A v7 repository can 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 + repository have upgraded git-annex and upgraded their repositories + to the new version before starting to use that feature, since old + versions of git-annex will ignore the new unlocked files. + + The behavior of some commands changes in an upgraded repository: + + * `git add` will add files to the annex, rather than adding them directly + to the git repository. To cause some files to be added directly + to git, you can configure `annex.largefiles`. For example: + + git config annex.largefiles "largerthan=100kb and not (include=*.c or include=*.h)" + + * `git annex unlock` and `git annex lock` change how the pointer to + the annexed content is stored in git. If you commit the change, + that will impact all clones of the repository. + + -- Joey Hess Fri, 13 Sep 2019 12:19:55 -0400 + git-annex (7.20181031) upstream; urgency=medium Repository version 7 is now available. v6 repositories will automatically diff --git a/Remote/Git.hs b/Remote/Git.hs --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -37,13 +37,11 @@ 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 import Utility.Metered import Utility.CopyFile -import Utility.FileMode import Utility.Env import Utility.Batch import Utility.SimpleProtocol @@ -62,6 +60,10 @@ import Annex.Action import Messages.Progress +#ifndef mingw32_HOST_OS +import Utility.FileMode +#endif + import Control.Concurrent import Control.Concurrent.MSampleVar import qualified Data.Map as M @@ -324,7 +326,7 @@ readlocalannexconfig = do let check = do Annex.BranchState.disableUpdate - void $ tryNonAsync $ ensureInitialized + catchNonAsync ensureInitialized (warning . show) Annex.getState Annex.repo s <- Annex.new r Annex.eval s $ check `finally` stopCoProcesses @@ -391,7 +393,6 @@ | not $ Git.repoIsUrl repo = ifM duc ( guardUsable repo (return False) $ commitOnCleanup repo r $ onLocalFast repo r $ do - ensureInitialized whenM (Annex.Content.inAnnex key) $ do Annex.Content.lockContentForRemoval key $ \lock -> do Annex.Content.removeAnnex lock @@ -489,7 +490,6 @@ hardlink <- wantHardLink -- run copy from perspective of remote onLocalFast repo r $ do - ensureInitialized v <- Annex.Content.prepSendAnnex key case v of Nothing -> return (False, UnVerified) @@ -631,7 +631,6 @@ onLocalFast repo r $ ifM (Annex.Content.inAnnex key) ( return True , do - ensureInitialized copier <- mkCopier hardlink st params let verify = Annex.Content.RemoteVerify r let rsp = RetrievalAllKeysSecure @@ -645,7 +644,7 @@ -- This is too broad really, but recvkey normally -- verifies content anyway, so avoid complicating -- it with a local sendAnnex check and rollback. - unlocked <- isDirect <||> versionSupportsUnlockedPointers + let unlocked = True oh <- mkOutputHandlerQuiet Ssh.rsyncHelper oh (Just p) =<< Ssh.rsyncParamsRemote unlocked r Upload key object file @@ -681,21 +680,25 @@ - The AnnexState is cached for speed and to avoid resource leaks. - However, coprocesses are stopped after each call to avoid git - processes hanging around on removable media. + - + - The remote will be automatically initialized/upgraded first, + - when possible. -} onLocal :: Git.Repo -> Remote -> Annex a -> Annex a onLocal repo r a = do m <- Annex.getState Annex.remoteannexstate - go =<< maybe - (liftIO $ Annex.new repo) - return - (M.lookup (uuid r) m) + case M.lookup (uuid r) m of + Nothing -> do + st <- liftIO $ Annex.new repo + go (st, ensureInitialized >> a) + Just st -> go (st, a) where cache st = Annex.changeState $ \s -> s { Annex.remoteannexstate = M.insert (uuid r) st (Annex.remoteannexstate s) } - go st = do + go (st, a') = do curro <- Annex.getState Annex.output (ret, st') <- liftIO $ Annex.run (st { Annex.output = curro }) $ - a `finally` stopCoProcesses + a' `finally` stopCoProcesses cache st' return ret @@ -719,13 +722,14 @@ {- Copys a file. Uses copy-on-write if it is supported. Otherwise, - uses rsync, so that interrupted copies can be resumed. -} rsyncOrCopyFile :: State -> [CommandParam] -> FilePath -> FilePath -> MeterUpdate -> Annex Bool -rsyncOrCopyFile st rsyncparams src dest p = #ifdef mingw32_HOST_OS +rsyncOrCopyFile _st _rsyncparams src dest p = -- rsync is only available on Windows in some installation methods, -- and is not strictly needed here, so don't use it. docopywith copyFileExternal where #else +rsyncOrCopyFile st rsyncparams src dest p = -- If multiple threads reach this at the same time, they -- will both try CoW, which is acceptable. ifM (liftIO $ isEmptyMVar copycowtried) @@ -775,8 +779,6 @@ wantHardLink :: Annex Bool wantHardLink = (annexHardLink <$> Annex.getGitConfig) - -- Not direct mode files because they can be modified at any time. - <&&> (not <$> isDirect) -- Not unlocked files that are hard linked in the work tree, -- because they can be modified at any time. <&&> (not <$> annexThin <$> Annex.getGitConfig) @@ -800,14 +802,13 @@ rsyncOrCopyFile st rsyncparams src dest p <&&> check localwanthardlink <- wantHardLink let linker = \src dest -> createLink src dest >> return True - ifM (pure (remotewanthardlink || localwanthardlink) <&&> not <$> isDirect) - ( return $ \src dest p check -> + if remotewanthardlink || localwanthardlink + then return $ \src dest p check -> ifM (liftIO (catchBoolIO (linker src dest))) ( return (True, Verified) , copier src dest p check ) - , return copier - ) + else return copier {- Normally the UUID of a local repository is checked at startup, - but annex-checkuuid config can prevent that. To avoid getting diff --git a/Test.hs b/Test.hs --- a/Test.hs +++ b/Test.hs @@ -30,7 +30,6 @@ import qualified Utility.SafeCommand import qualified Annex -import qualified Annex.Version import qualified Git.Filename import qualified Git.Types import qualified Git.Ref @@ -151,9 +150,7 @@ 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)) - , Just ("v5 direct", (testMode opts (RepoVersion 5)) { forceDirect = True }) ] unlesscrippled v | crippledfilesystem = Nothing @@ -231,12 +228,11 @@ , 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 , testCase "fix" test_fix - , testCase "direct" test_direct , testCase "trust" test_trust , testCase "fsck (basics)" test_fsck_basic , testCase "fsck (bare)" test_fsck_bare @@ -302,19 +298,11 @@ git_annex "unlock" [sha1annexedfile] @? "unlock failed" annexed_present sha1annexedfile checkbackend sha1annexedfile backendSHA1 - ifM (annexeval Config.isDirect) - ( do - writecontent ingitfile $ content ingitfile - not <$> boolSystem "git" [Param "add", File ingitfile] @? "git add failed to fail in direct mode" - nukeFile ingitfile - git_annex "sync" [] @? "sync failed" - , do - writecontent ingitfile $ content ingitfile - boolSystem "git" [Param "add", File ingitfile] @? "git add failed" - boolSystem "git" [Param "commit", Param "-q", Param "-m", Param "commit"] @? "git commit failed" - git_annex "add" [ingitfile] @? "add ingitfile should be no-op" - unannexed ingitfile - ) + writecontent ingitfile $ content ingitfile + boolSystem "git" [Param "add", File ingitfile] @? "git add failed" + boolSystem "git" [Param "commit", Param "-q", Param "-m", Param "commit"] @? "git commit failed" + git_annex "add" [ingitfile] @? "add ingitfile should be no-op" + unannexed ingitfile test_add_dup :: Assertion test_add_dup = intmpclonerepo $ do @@ -394,7 +382,7 @@ return (importdir subdir, importdir importf, importf) test_reinject :: Assertion -test_reinject = intmpclonerepoInDirect $ do +test_reinject = intmpclonerepo $ do git_annex "drop" ["--force", sha1annexedfile] @? "drop failed" annexed_notpresent sha1annexedfile writecontent tmp $ content sha1annexedfile @@ -423,9 +411,8 @@ unannexed annexedfile git_annex "unannex" [annexedfile] @? "unannex failed on non-annexed file" unannexed annexedfile - unlessM (annexeval Config.isDirect) $ do - git_annex "unannex" [ingitfile] @? "unannex ingitfile should be no-op" - unannexed ingitfile + git_annex "unannex" [ingitfile] @? "unannex ingitfile should be no-op" + unannexed ingitfile test_drop_noremote :: Assertion test_drop_noremote = intmpclonerepo $ do @@ -437,9 +424,8 @@ git_annex "drop" ["--force", annexedfile] @? "drop --force failed" annexed_notpresent annexedfile git_annex "drop" [annexedfile] @? "drop of dropped file failed" - unlessM (annexeval Config.isDirect) $ do - git_annex "drop" [ingitfile] @? "drop ingitfile should be no-op" - unannexed ingitfile + git_annex "drop" [ingitfile] @? "drop ingitfile should be no-op" + unannexed ingitfile test_drop_withremote :: Assertion test_drop_withremote = intmpclonerepo $ do @@ -485,12 +471,11 @@ git_annex "get" [annexedfile] @? "get of file already here failed" inmainrepo $ annexed_present annexedfile annexed_present annexedfile - unlessM (annexeval Config.isDirect) $ do - inmainrepo $ unannexed ingitfile - unannexed ingitfile - git_annex "get" [ingitfile] @? "get ingitfile should be no-op" - inmainrepo $ unannexed ingitfile - unannexed ingitfile + inmainrepo $ unannexed ingitfile + unannexed ingitfile + git_annex "get" [ingitfile] @? "get ingitfile should be no-op" + inmainrepo $ unannexed ingitfile + unannexed ingitfile test_move :: Assertion test_move = test_move' intmpclonerepo @@ -519,15 +504,14 @@ git_annex "move" ["--to", "origin", annexedfile] @? "move --to of file already there failed" inmainrepo $ annexed_present annexedfile annexed_notpresent annexedfile - unlessM (annexeval Config.isDirect) $ do - unannexed ingitfile - inmainrepo $ unannexed ingitfile - git_annex "move" ["--to", "origin", ingitfile] @? "move of ingitfile should be no-op" - unannexed ingitfile - inmainrepo $ unannexed ingitfile - git_annex "move" ["--from", "origin", ingitfile] @? "move of ingitfile should be no-op" - unannexed ingitfile - inmainrepo $ unannexed ingitfile + unannexed ingitfile + inmainrepo $ unannexed ingitfile + git_annex "move" ["--to", "origin", ingitfile] @? "move of ingitfile should be no-op" + unannexed ingitfile + inmainrepo $ unannexed ingitfile + git_annex "move" ["--from", "origin", ingitfile] @? "move of ingitfile should be no-op" + unannexed ingitfile + inmainrepo $ unannexed ingitfile test_copy :: Assertion test_copy = intmpclonerepo $ do @@ -545,15 +529,14 @@ git_annex "move" ["--to", "origin", annexedfile] @? "move --to of file already there failed" annexed_notpresent annexedfile inmainrepo $ annexed_present annexedfile - unlessM (annexeval Config.isDirect) $ do - unannexed ingitfile - inmainrepo $ unannexed ingitfile - git_annex "copy" ["--to", "origin", ingitfile] @? "copy of ingitfile should be no-op" - unannexed ingitfile - inmainrepo $ unannexed ingitfile - git_annex "copy" ["--from", "origin", ingitfile] @? "copy of ingitfile should be no-op" - checkregularfile ingitfile - checkcontent ingitfile + unannexed ingitfile + inmainrepo $ unannexed ingitfile + git_annex "copy" ["--to", "origin", ingitfile] @? "copy of ingitfile should be no-op" + unannexed ingitfile + inmainrepo $ unannexed ingitfile + git_annex "copy" ["--from", "origin", ingitfile] @? "copy of ingitfile should be no-op" + checkregularfile ingitfile + checkcontent ingitfile test_preferred_content :: Assertion test_preferred_content = intmpclonerepo $ do @@ -597,23 +580,14 @@ annexed_notpresent annexedfile test_lock :: Assertion -test_lock = intmpclonerepoInDirect $ 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" - ) +test_lock = intmpclonerepo $ do 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 @@ -625,21 +599,15 @@ 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] @@ -648,21 +616,20 @@ -- 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 = intmpclonerepoInDirect $ 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 @@ -671,7 +638,7 @@ test_edit_precommit = test_edit' True test_edit' :: Bool -> Assertion -test_edit' precommit = intmpclonerepoInDirect $ do +test_edit' precommit = intmpclonerepo $ do git_annex "get" [annexedfile] @? "get of file failed" annexed_present annexedfile git_annex "edit" [annexedfile] @? "edit failed" @@ -684,29 +651,22 @@ @? "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" test_partial_commit :: Assertion -test_partial_commit = intmpclonerepoInDirect $ do +test_partial_commit = intmpclonerepo $ do git_annex "get" [annexedfile] @? "get of file failed" 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 = intmpclonerepoInDirect $ unlessM (hasUnlockedFiles <$> getTestMode) $ do +test_fix = intmpclonerepo $ unlessM (hasUnlockedFiles <$> getTestMode) $ do annexed_notpresent annexedfile git_annex "fix" [annexedfile] @? "fix of not present failed" annexed_notpresent annexedfile @@ -725,18 +685,6 @@ subdir = "s" newfile = subdir ++ "/" ++ annexedfile -test_direct :: Assertion -test_direct = intmpclonerepoInDirect $ do - git_annex "get" [annexedfile] @? "get of file failed" - annexed_present annexedfile - ifM (annexeval Annex.Version.versionSupportsUnlockedPointers) - ( git_annex_shouldfail "direct" [] @? "switch to direct mode failed to fail in v7 repository" - , do - git_annex "direct" [] @? "switch to direct mode failed" - annexed_present annexedfile - git_annex "indirect" [] @? "switch to indirect mode failed" - ) - test_trust :: Assertion test_trust = intmpclonerepo $ do git_annex "trust" [repo] @? "trust failed" @@ -777,7 +725,7 @@ git_annex "get" [f] @? "get of file failed" Utility.FileMode.allowWrite f writecontent f (changedcontent f) - ifM (annexeval Config.isDirect <||> hasUnlockedFiles <$> getTestMode) + ifM (hasUnlockedFiles <$> getTestMode) ( git_annex "fsck" [] @? "fsck failed on unlocked file with changed file content" , git_annex_shouldfail "fsck" [] @? "fsck failed to fail with corrupted file content" ) @@ -820,7 +768,7 @@ test_migrate_via_gitattributes = test_migrate' True test_migrate' :: Bool -> Assertion -test_migrate' usegitattributes = intmpclonerepoInDirect $ do +test_migrate' usegitattributes = intmpclonerepo $ do annexed_notpresent annexedfile annexed_notpresent sha1annexedfile git_annex "migrate" [annexedfile] @? "migrate of not present failed" @@ -858,8 +806,7 @@ checkbackend sha1annexedfile backendSHA256 test_unused :: Assertion --- This test is broken in direct mode. -test_unused = intmpclonerepoInDirect $ do +test_unused = intmpclonerepo $ do checkunused [] "in new clone" git_annex "get" [annexedfile] @? "get of file failed" git_annex "get" [sha1annexedfile] @? "get of file failed" @@ -991,10 +938,6 @@ test_sync :: Assertion test_sync = intmpclonerepo $ do git_annex "sync" [] @? "sync failed" - {- Regression test for bug fixed in - - 7b0970b340d7faeb745c666146c7f701ec71808f, where in direct mode - - sync committed the symlink standin file to the annex. -} - git_annex_expectoutput "find" ["--in", "."] [] {- Regression test for bug fixed in - 039e83ed5d1a11fd562cce55b8429c840d72443e, where a present - wanted file was dropped. -} @@ -1051,12 +994,8 @@ forM_ [r1, r2] $ \r -> indir r $ do {- Set up a conflict. -} let newcontent = content annexedfile ++ rname r - ifM (annexeval Config.isDirect) - ( writecontent annexedfile newcontent - , do - git_annex "unlock" [annexedfile] @? "unlock failed" - writecontent annexedfile newcontent - ) + git_annex "unlock" [annexedfile] @? "unlock failed" + writecontent annexedfile newcontent {- Sync twice in r1 so it gets the conflict resolution - update from r2 -} forM_ [r1, r2, r1] $ \r -> indir r $ @@ -1065,9 +1004,8 @@ - files. This includes both sides of the conflict, - although the filenames are not easily predictable. - - - The bug caused, in direct mode, one repo to - - be missing the content of the file that had - - been put in it. -} + - The bug caused one repo to be missing the content + - of the file that had been put in it. -} forM_ [r1, r2] $ \r -> indir r $ do git_annex "get" [] @? "unable to get all files after merge conflict resolution in " ++ rname r @@ -1120,8 +1058,6 @@ 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. @@ -1207,9 +1143,8 @@ git_annex "sync" [] @? "sync failed in r2" git_annex "get" [conflictor] @? "get conflictor failed" - unlessM (annexeval Config.isDirect) $ do - git_annex "unlock" [conflictor] - @? "unlock conflictor failed" + git_annex "unlock" [conflictor] + @? "unlock conflictor failed" writecontent conflictor "newconflictor" indir r1 $ nukeFile conflictor @@ -1230,44 +1165,35 @@ {- Check merge confalict resolution when a file is annexed in one repo, - and checked directly into git in the other repo. - - - - This test requires indirect mode to set it up, but tests both direct and - - indirect mode. -} test_nonannexed_file_conflict_resolution :: Assertion test_nonannexed_file_conflict_resolution = do - check True False - check False False - check True True - check False True + check True + check False where - check inr1 switchdirect = withtmpclonerepo $ \r1 -> - withtmpclonerepo $ \r2 -> - whenM (isInDirect r1 <&&> isInDirect r2) $ do - indir r1 $ do - disconnectOrigin - writecontent conflictor "conflictor" - add_annex conflictor @? "add conflicter failed" - git_annex "sync" [] @? "sync failed in r1" - indir r2 $ do - disconnectOrigin - writecontent conflictor nonannexed_content - boolSystem "git" - [ Param "config" - , Param "annex.largefiles" - , Param ("exclude=" ++ ingitfile ++ " and exclude=" ++ conflictor) - ] @? "git config annex.largefiles failed" - boolSystem "git" [Param "add", File conflictor] @? "git add conflictor failed" - git_annex "sync" [] @? "sync failed in r2" - pair r1 r2 - let l = if inr1 then [r1, r2] else [r2, r1] - forM_ l $ \r -> indir r $ do - when switchdirect $ - whenM (annexeval Annex.Version.versionSupportsDirectMode) $ - git_annex "direct" [] @? "failed switching to direct mode" - git_annex "sync" [] @? "sync failed" - checkmerge ("r1" ++ show switchdirect) r1 - checkmerge ("r2" ++ show switchdirect) r2 + check inr1 = withtmpclonerepo $ \r1 -> + withtmpclonerepo $ \r2 -> do + indir r1 $ do + disconnectOrigin + writecontent conflictor "conflictor" + add_annex conflictor @? "add conflicter failed" + git_annex "sync" [] @? "sync failed in r1" + indir r2 $ do + disconnectOrigin + writecontent conflictor nonannexed_content + boolSystem "git" + [ Param "config" + , Param "annex.largefiles" + , Param ("exclude=" ++ ingitfile ++ " and exclude=" ++ conflictor) + ] @? "git config annex.largefiles failed" + boolSystem "git" [Param "add", File conflictor] @? "git add conflictor failed" + git_annex "sync" [] @? "sync failed in r2" + pair r1 r2 + let l = if inr1 then [r1, r2] else [r2, r1] + forM_ l $ \r -> indir r $ + git_annex "sync" [] @? "sync failed" + checkmerge "r1" r1 + checkmerge "r2" r2 conflictor = "conflictor" nonannexed_content = "nonannexed" variantprefix = conflictor ++ ".variant" @@ -1284,7 +1210,7 @@ @? (what ++ " wrong content for nonannexed file: " ++ show s) -{- Check merge confalict resolution when a file is annexed in one repo, +{- Check merge conflict resolution when a file is annexed in one repo, - and is a non-git-annex symlink in the other repo. - - Test can only run when coreSymlinks is supported, because git needs to @@ -1292,15 +1218,12 @@ -} test_nonannexed_symlink_conflict_resolution :: Assertion test_nonannexed_symlink_conflict_resolution = do - check True False - check False False - check True True - check False True + check True + check False where - check inr1 switchdirect = withtmpclonerepo $ \r1 -> + check inr1 = withtmpclonerepo $ \r1 -> withtmpclonerepo $ \r2 -> - whenM (checkRepo (Types.coreSymlinks <$> Annex.getGitConfig) r1 - <&&> isInDirect r1 <&&> isInDirect r2) $ do + whenM (checkRepo (Types.coreSymlinks <$> Annex.getGitConfig) r1) $ do indir r1 $ do disconnectOrigin writecontent conflictor "conflictor" @@ -1313,13 +1236,10 @@ git_annex "sync" [] @? "sync failed in r2" pair r1 r2 let l = if inr1 then [r1, r2] else [r2, r1] - forM_ l $ \r -> indir r $ do - when switchdirect $ - whenM (annexeval Annex.Version.versionSupportsDirectMode) $ do - git_annex "direct" [] @? "failed switching to direct mode" + forM_ l $ \r -> indir r $ git_annex "sync" [] @? "sync failed" - checkmerge ("r1" ++ show switchdirect) r1 - checkmerge ("r2" ++ show switchdirect) r2 + checkmerge "r1" r1 + checkmerge "r2" r2 conflictor = "conflictor" symlinktarget = "dummy-target" variantprefix = conflictor ++ ".variant" @@ -1361,24 +1281,11 @@ disconnectOrigin writecontent conflictor localcontent pair r1 r2 - indir r2 $ ifM (annexeval Config.isDirect) - ( do - git_annex "sync" [] @? "sync failed" - let local = conflictor ++ localprefix - doesFileExist local @? (local ++ " missing after merge") - s <- readFile local - s == localcontent @? (local ++ " has wrong content: " ++ s) - git_annex "get" [conflictor] @? "get failed" - doesFileExist remoteconflictor @? (remoteconflictor ++ " missing after merge") - s' <- readFile remoteconflictor - s' == annexedcontent @? (remoteconflictor ++ " has wrong content: " ++ s) - -- this case is intentionally not handled - -- in indirect mode, since the user - -- can recover on their own easily - , git_annex_shouldfail "sync" [] @? "sync failed to fail" - ) + -- this case is intentionally not handled + -- since the user can recover on their own easily + indir r2 $ git_annex_shouldfail "sync" [] + @? "sync failed to fail" conflictor = "conflictor" - localprefix = ".variant-local" localcontent = "local" annexedcontent = "annexed" @@ -1414,19 +1321,19 @@ 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" @@ -1438,10 +1345,9 @@ 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 @@ -1527,7 +1433,7 @@ doesDirectoryExist ".git" @? ".git vanished in uninit" test_uninit_inbranch :: Assertion -test_uninit_inbranch = intmpclonerepoInDirect $ do +test_uninit_inbranch = intmpclonerepo $ do boolSystem "git" [Param "checkout", Param "git-annex"] @? "git checkout git-annex" git_annex_shouldfail "uninit" [] @? "uninit failed to fail when git-annex branch was checked out" @@ -1744,7 +1650,7 @@ doesFileExist dest @? (dest ++ " missing after addurl --file") test_export_import :: Assertion -test_export_import = intmpclonerepoInDirect $ do +test_export_import = intmpclonerepo $ do createDirectory "dir" git_annex "initremote" (words "foo type=directory encryption=none directory=dir exporttree=yes importtree=yes") @? "initremote failed" git_annex "get" [] @? "get of files failed" @@ -1798,7 +1704,7 @@ commitchanges = git_annex "sync" ["--no-pull", "--no-push"] @? "sync failed" test_export_import_subdir :: Assertion -test_export_import_subdir = intmpclonerepoInDirect $ do +test_export_import_subdir = intmpclonerepo $ do createDirectory "dir" git_annex "initremote" (words "foo type=directory encryption=none directory=dir exporttree=yes importtree=yes") @? "initremote failed" git_annex "get" [] @? "get of files failed" diff --git a/Test/Framework.hs b/Test/Framework.hs --- a/Test/Framework.hs +++ b/Test/Framework.hs @@ -31,7 +31,6 @@ import qualified Config import qualified Annex.WorkTree import qualified Annex.Link -import qualified Annex.Init import qualified Annex.Path import qualified Annex.Action import qualified Annex.AdjustedBranch @@ -98,26 +97,12 @@ intmpclonerepo :: Assertion -> Assertion intmpclonerepo a = withtmpclonerepo $ \r -> indir r a -intmpclonerepoInDirect :: Assertion -> Assertion -intmpclonerepoInDirect a = intmpclonerepo $ - ifM isdirect - ( putStrLn "not supported in direct mode; skipping" - , a - ) - where - isdirect = annexeval $ do - Annex.Init.initialize Nothing Nothing - Config.isDirect - checkRepo :: Types.Annex a -> FilePath -> IO a checkRepo getval d = do s <- Annex.new =<< Git.Construct.fromPath d Annex.eval s $ getval `finally` Annex.Action.stopCoProcesses -isInDirect :: FilePath -> IO Bool -isInDirect = checkRepo (not <$> Config.isDirect) - intmpbareclonerepo :: Assertion -> Assertion intmpbareclonerepo a = withtmpclonerepo' (newCloneRepoConfig { bareClone = True } ) $ \r -> indir r a @@ -165,7 +150,7 @@ 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 @@ -259,17 +244,13 @@ removeDirectoryRecursive tmpdir checklink :: FilePath -> Assertion -checklink f = - -- in direct mode, it may be a symlink, or not, depending - -- on whether the content is present. - unlessM (annexeval Config.isDirect) $ - ifM (annexeval Config.crippledFileSystem) - ( (isJust <$> annexeval (Annex.Link.getAnnexLinkTarget f)) - @? f ++ " is not a (crippled) symlink" - , do - s <- getSymbolicLinkStatus f - isSymbolicLink s @? f ++ " is not a symlink" - ) +checklink f = ifM (annexeval Config.crippledFileSystem) + ( (isJust <$> annexeval (Annex.Link.getAnnexLinkTarget f)) + @? f ++ " is not a (crippled) symlink" + , do + s <- getSymbolicLinkStatus f + isSymbolicLink s @? f ++ " is not a symlink" + ) checkregularfile :: FilePath -> Assertion checkregularfile f = do @@ -293,7 +274,7 @@ assertEqual ("checkcontent " ++ f) (content f) c checkunwritable :: FilePath -> Assertion -checkunwritable f = unlessM (annexeval Config.isDirect) $ do +checkunwritable f = do -- Look at permissions bits rather than trying to write or -- using fileAccess because if run as root, any file can be -- modified despite permissions. @@ -408,8 +389,7 @@ ) data TestMode = TestMode - { forceDirect :: Bool - , unlockedFiles :: Bool + { unlockedFiles :: Bool , adjustedUnlockedBranch :: Bool , annexVersion :: Types.RepoVersion.RepoVersion , keepFailures :: Bool @@ -417,8 +397,7 @@ testMode :: TestOptions -> Types.RepoVersion.RepoVersion -> TestMode testMode opts v = TestMode - { forceDirect = False - , unlockedFiles = False + { unlockedFiles = False , adjustedUnlockedBranch = False , annexVersion = v , keepFailures = keepFailuresOption opts @@ -477,8 +456,6 @@ setupTestMode :: IO () setupTestMode = do testmode <- getTestMode - when (forceDirect testmode) $ - git_annex "direct" ["-q"] @? "git annex direct failed" when (adjustedUnlockedBranch testmode) $ do boolSystem "git" [Param "commit", Param "--allow-empty", Param "-m", Param "empty"] @? "git commit failed" git_annex "adjust" ["--unlock"] @? "git annex adjust failed" diff --git a/Types/GitConfig.hs b/Types/GitConfig.hs --- a/Types/GitConfig.hs +++ b/Types/GitConfig.hs @@ -103,6 +103,7 @@ , annexMaxExtensionLength :: Maybe Int , annexJobs :: Concurrency , annexCacheCreds :: Bool + , annexAutoUpgradeRepository :: Bool , coreSymlinks :: Bool , coreSharedRepository :: SharedRepository , receiveDenyCurrentBranch :: DenyCurrentBranch @@ -182,6 +183,7 @@ , 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 --- 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 @@ 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 @@ up (RepoVersion 5) = Upgrade.V5.upgrade automatic up (RepoVersion 6) = Upgrade.V6.upgrade automatic up _ = return True + diff --git a/Upgrade/V4.hs b/Upgrade/V4.hs --- a/Upgrade/V4.hs +++ b/Upgrade/V4.hs @@ -8,16 +8,8 @@ module Upgrade.V4 where import Annex.Common -import Config -import Annex.Direct -{- Direct mode only upgrade. v4 to v5 indirect update is a no-op -} +{- Was only used for direct mode upgrade. v4 to v5 indirect update is a no-op, + - and direct mode is no longer supported, so nothing needs to be done. -} upgrade :: Bool -> Annex Bool -upgrade automatic = ifM isDirect - ( do - unless automatic $ - showAction "v4 to v5" - setDirect True - return True - , return True - ) +upgrade _automatic = return True diff --git a/Upgrade/V5.hs b/Upgrade/V5.hs --- a/Upgrade/V5.hs +++ b/Upgrade/V5.hs @@ -1,6 +1,6 @@ {- git-annex v5 -> v6 upgrade support - - - Copyright 2015-2016 Joey Hess + - Copyright 2015-2019 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -13,78 +13,99 @@ import Config.Smudge import Annex.InodeSentinal import Annex.Link -import Annex.Direct -import Annex.Content import Annex.CatFile import Annex.WorkTree +import Annex.UUID +import Logs.Location +import qualified Upgrade.V5.Direct as Direct +import qualified Annex.Content as Content import qualified Database.Keys -import qualified Annex.Content.Direct as Direct import qualified Git import qualified Git.LsFiles import qualified Git.Branch +import qualified Git.Version import Git.FilePath import Git.FileMode import Git.Config import Git.Ref import Utility.InodeCache +import Utility.DottedVersion import Annex.AdjustedBranch import qualified Data.ByteString as S upgrade :: Bool -> Annex Bool -upgrade automatic = do +upgrade automatic = flip catchNonAsync (const $ return False) $ do unless automatic $ showAction "v5 to v6" - whenM isDirect $ do - {- Direct mode makes the same tradeoff of using less disk - - space, with less preservation of old versions of files - - as does annex.thin. -} - setConfig (annexConfig "thin") (boolConfig True) - Annex.changeGitConfig $ \c -> c { annexThin = True } - {- Since upgrade from direct mode changes how files - - are represented in git, by checking out an adjusted - - branch, commit any changes in the work tree first. -} - whenM stageDirect $ do - unless automatic $ - showAction "committing first" - upgradeDirectCommit automatic - "commit before upgrade to annex.version 6" - setDirect False - cur <- fromMaybe (error "Somehow no branch is checked out") - <$> inRepo Git.Branch.current - upgradeDirectWorkTree - removeDirectCruft - {- Create adjusted branch where all files are unlocked. - - This should have the same content for each file as - - have been staged in upgradeDirectWorkTree. -} - AdjBranch b <- adjustBranch (LinkAdjustment UnlockAdjustment) cur - {- Since the work tree was already set up by - - upgradeDirectWorkTree, and contains unlocked file - - contents too, don't use git checkout to check out the - - adjust branch. Instead, update HEAD manually. -} - inRepo $ setHeadRef b - scanUnlockedFiles + ifM isDirect + ( do + checkGitVersionForDirectUpgrade + convertDirect + -- Worktree files are already populated, so don't + -- have this try to populate them again. + scanUnlockedFiles False + , do + checkGitVersionForIndirectUpgrade + scanUnlockedFiles True + ) configureSmudgeFilter -- Inode sentinal file was only used in direct mode and when -- locking down files as they were added. In v6, it's used more -- extensively, so make sure it exists, since old repos that didn't -- use direct mode may not have created it. - unlessM (isDirect) $ + unlessM isDirect $ createInodeSentinalFile True return True -upgradeDirectCommit :: Bool -> String -> Annex () -upgradeDirectCommit automatic msg = - void $ inRepo $ Git.Branch.commitCommand commitmode - [ Param "-m" - , Param msg - ] - where - commitmode = if automatic then Git.Branch.AutomaticCommit else Git.Branch.ManualCommit +-- git before 2.22 would OOM running git status on a large file. +-- +-- Older versions of git that are patched (with +-- commit 02156ab031e430bc45ce6984dfc712de9962dec8) +-- can include "oomfix" in their version to indicate it. +gitWillOOM :: Annex Bool +gitWillOOM = liftIO $ do + v <- Git.Version.installed + return $ v < Git.Version.normalize "2.22" && + not ("oomfix" `isInfixOf` fromDottedVersion v) +-- configureSmudgeFilter has to run git status, and direct mode files +-- are unlocked, so avoid the upgrade failing half way through. +checkGitVersionForDirectUpgrade :: Annex () +checkGitVersionForDirectUpgrade = whenM gitWillOOM $ + giveup "You must upgrade git to version 2.22 or newer in order to use this version of git-annex in this repository." + +checkGitVersionForIndirectUpgrade :: Annex () +checkGitVersionForIndirectUpgrade = whenM gitWillOOM $ + warning "Git is older than version 2.22 and so it has a memory leak that affects using unlocked files. Recommend you upgrade git before unlocking any files in your repository." + +convertDirect :: Annex () +convertDirect = do + {- Direct mode makes the same tradeoff of using less disk + - space, with less preservation of old versions of files + - as does annex.thin. -} + setConfig (annexConfig "thin") (boolConfig True) + Annex.changeGitConfig $ \c -> c { annexThin = True } + Direct.setIndirect + cur <- fromMaybe (error "Somehow no branch is checked out") + <$> inRepo Git.Branch.current + upgradeDirectWorkTree + removeDirectCruft + {- Create adjusted branch where all files are unlocked. + - This should have the same content for each file as + - have been staged in upgradeDirectWorkTree. -} + AdjBranch b <- adjustBranch (LinkAdjustment UnlockAdjustment) cur + {- Since the work tree was already set up by + - upgradeDirectWorkTree, and contains unlocked file + - contents too, don't use git checkout to check out the + - adjust branch. Instead, update HEAD manually. -} + inRepo $ setHeadRef b + {- Walk work tree from top and convert all annex symlinks to pointer files, - - staging them in the index, and updating the work tree files with - - either the content of the object, or the pointer file content. -} + - staging them in the index, and populating the annex objects with + - hard links (or copies) of the work tree files (when not modified or + - deleted). + -} upgradeDirectWorkTree :: Annex () upgradeDirectWorkTree = do top <- fromRepo Git.repoPath @@ -99,31 +120,41 @@ case mk of Nothing -> noop Just k -> do + stagePointerFile f Nothing =<< hashPointerFile k ifM (isJust <$> getAnnexLinkTarget f) ( writepointer f k , fromdirect f k ) - stagePointerFile f Nothing =<< hashPointerFile k Database.Keys.addAssociatedFile k =<< inRepo (toTopFilePath f) - return () go _ = noop - fromdirect f k = do - -- If linkToAnnex fails for some reason, the work tree file - -- still has the content; the annex object file is just - -- not populated with it. Since the work tree file - -- is recorded as an associated file, things will still - -- work that way, it's just not ideal. - ic <- withTSDelta (liftIO . genInodeCache f) - void $ linkToAnnex k f ic + fromdirect f k = ifM (Direct.goodContent k f) + ( do + -- If linkToAnnex fails for some reason, the work tree + -- file still has the content; the annex object file + -- is just not populated with it. Since the work tree + -- file is recorded as an associated file, things will + -- still work that way, it's just not ideal. + ic <- withTSDelta (liftIO . genInodeCache f) + void $ Content.linkToAnnex k f ic + , unlessM (Content.inAnnex k) $ do + -- Worktree file was deleted or modified; + -- if there are no other copies of the content + -- then it's been lost. + locs <- Direct.associatedFiles k + unlessM (anyM (Direct.goodContent k) locs) $ do + u <- getUUID + logChange k u InfoMissing + ) + writepointer f k = liftIO $ do nukeFile f S.writeFile f (formatPointer k) {- Remove all direct mode bookkeeping files. -} removeDirectCruft :: Annex () -removeDirectCruft = mapM_ go =<< getKeysPresent InAnywhere +removeDirectCruft = mapM_ go =<< Content.listKeys Content.InAnywhere where go k = do Direct.removeInodeCache k diff --git a/Upgrade/V5/Direct.hs b/Upgrade/V5/Direct.hs new file mode 100644 --- /dev/null +++ b/Upgrade/V5/Direct.hs @@ -0,0 +1,126 @@ +{- git-annex direct mode + - + - This only contains some remnants needed to convert away from direct mode. + - + - Copyright 2012-2014 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +module Upgrade.V5.Direct ( + switchHEADBack, + setIndirect, + goodContent, + associatedFiles, + removeAssociatedFiles, + removeInodeCache, +) where + +import Annex.Common +import qualified Annex +import qualified Git +import qualified Git.Config +import qualified Git.Ref +import qualified Git.Branch +import Git.Types +import Config +import Annex.Perms +import Utility.InodeCache +import Annex.InodeSentinal + +setIndirect :: Annex () +setIndirect = do + setbare + switchHEADBack + setConfig (annexConfig "direct") val + Annex.changeGitConfig $ \c -> c { annexDirect = False } + where + val = Git.Config.boolConfig False + coreworktree = ConfigKey "core.worktree" + indirectworktree = ConfigKey "core.indirect-worktree" + setbare = do + -- core.worktree is not compatable with + -- core.bare; git does not allow both to be set, so + -- unset it when enabling direct mode, caching in + -- core.indirect-worktree + moveconfig indirectworktree coreworktree + setConfig (ConfigKey Git.Config.coreBare) val + moveconfig src dest = getConfigMaybe src >>= \case + Nothing -> noop + Just wt -> do + unsetConfig src + setConfig dest wt + reloadConfig + +{- Converts a directBranch back to the original branch. + - + - Any other ref is left unchanged. + -} +fromDirectBranch :: Ref -> Ref +fromDirectBranch directhead = case splitc '/' $ fromRef directhead of + ("refs":"heads":"annex":"direct":rest) -> + Ref $ "refs/heads/" ++ intercalate "/" rest + _ -> directhead + +switchHEADBack :: Annex () +switchHEADBack = maybe noop switch =<< inRepo Git.Branch.currentUnsafe + where + switch currhead = do + let orighead = fromDirectBranch currhead + inRepo (Git.Ref.sha currhead) >>= \case + Just headsha + | orighead /= currhead -> do + inRepo $ Git.Branch.update "leaving direct mode" orighead headsha + inRepo $ Git.Branch.checkout orighead + inRepo $ Git.Branch.delete currhead + _ -> inRepo $ Git.Branch.checkout orighead + +{- Absolute FilePaths of Files in the tree that are associated with a key. -} +associatedFiles :: Key -> Annex [FilePath] +associatedFiles key = do + files <- associatedFilesRelative key + top <- fromRepo Git.repoPath + return $ map (top ) files + +{- List of files in the tree that are associated with a key, relative to + - the top of the repo. -} +associatedFilesRelative :: Key -> Annex [FilePath] +associatedFilesRelative key = do + mapping <- calcRepo $ gitAnnexMapping key + liftIO $ catchDefaultIO [] $ withFile mapping ReadMode $ \h -> + -- Read strictly to ensure the file is closed promptly + lines <$> hGetContentsStrict h + +{- Removes the list of associated files. -} +removeAssociatedFiles :: Key -> Annex () +removeAssociatedFiles key = do + mapping <- calcRepo $ gitAnnexMapping key + modifyContent mapping $ + liftIO $ nukeFile mapping + +{- Checks if a file in the tree, associated with a key, has not been modified. + - + - To avoid needing to fsck the file's content, which can involve an + - expensive checksum, this relies on a cache that contains the file's + - expected mtime and inode. + -} +goodContent :: Key -> FilePath -> Annex Bool +goodContent key file = sameInodeCache file =<< recordedInodeCache key + +{- Gets the recorded inode cache for a key. + - + - A key can be associated with multiple files, so may return more than + - one. -} +recordedInodeCache :: Key -> Annex [InodeCache] +recordedInodeCache key = withInodeCacheFile key $ \f -> + liftIO $ catchDefaultIO [] $ + mapMaybe readInodeCache . lines <$> readFileStrict f + +{- Removes an inode cache. -} +removeInodeCache :: Key -> Annex () +removeInodeCache key = withInodeCacheFile key $ \f -> + modifyContent f $ + liftIO $ nukeFile f + +withInodeCacheFile :: Key -> (FilePath -> Annex a) -> Annex a +withInodeCacheFile key a = a =<< calcRepo (gitAnnexInodeCache key) diff --git a/Utility/CopyFile.hs b/Utility/CopyFile.hs --- a/Utility/CopyFile.hs +++ b/Utility/CopyFile.hs @@ -35,7 +35,8 @@ 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/Utility/DottedVersion.hs b/Utility/DottedVersion.hs --- a/Utility/DottedVersion.hs +++ b/Utility/DottedVersion.hs @@ -18,7 +18,10 @@ compare (DottedVersion _ x) (DottedVersion _ y) = compare x y instance Show DottedVersion where - show (DottedVersion s _) = s + show = fromDottedVersion + +fromDottedVersion :: DottedVersion -> String +fromDottedVersion (DottedVersion s _) = s {- To compare dotted versions like 1.7.7 and 1.8, they are normalized to - a somewhat arbitrary integer representation. -} diff --git a/Utility/InodeCache.hs b/Utility/InodeCache.hs --- a/Utility/InodeCache.hs +++ b/Utility/InodeCache.hs @@ -170,7 +170,9 @@ toInodeCache :: TSDelta -> FilePath -> FileStatus -> IO (Maybe InodeCache) toInodeCache (TSDelta getdelta) f s | isRegularFile s = do +#ifndef mingw32_HOST_OS delta <- getdelta +#endif sz <- getFileSize' f s #ifdef mingw32_HOST_OS mtime <- MTimeHighRes . utcTimeToPOSIXSeconds <$> getModificationTime f diff --git a/Utility/Path/Max.hs b/Utility/Path/Max.hs --- a/Utility/Path/Max.hs +++ b/Utility/Path/Max.hs @@ -10,8 +10,6 @@ module Utility.Path.Max where -import System.FilePath - #ifndef mingw32_HOST_OS import Utility.Exception import System.Posix.Files diff --git a/doc/git-annex-add.mdwn b/doc/git-annex-add.mdwn --- a/doc/git-annex-add.mdwn +++ b/doc/git-annex-add.mdwn @@ -22,9 +22,8 @@ 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, or is in direct mode.) -To add a file to the annex in unlocked form, `git add` can be used instead -(that only works in repository v7 or higher). +supporting symlinks.) +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 --- a/doc/git-annex-adjust.mdwn +++ b/doc/git-annex-adjust.mdwn @@ -34,8 +34,6 @@ 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-contentlocation.mdwn b/doc/git-annex-contentlocation.mdwn --- a/doc/git-annex-contentlocation.mdwn +++ b/doc/git-annex-contentlocation.mdwn @@ -12,10 +12,6 @@ of a key. The filename is output to stdout. If the key's content is not present in the local repository, nothing is output, and it exits nonzero. -Note that in direct mode, the file will typically be in the git work -tree, and while its content should correspond to the key, the file -could become modified at any time after git-annex checks it. - # OPTIONS * `--batch` diff --git a/doc/git-annex-direct.mdwn b/doc/git-annex-direct.mdwn --- a/doc/git-annex-direct.mdwn +++ b/doc/git-annex-direct.mdwn @@ -1,6 +1,6 @@ # NAME -git-annex direct - switch repository to direct mode +git-annex direct - switch repository to direct mode (deprecated) # SYNOPSIS @@ -8,28 +8,15 @@ # DESCRIPTION -Switches a repository to use direct mode, where rather than symlinks to -files, the files are directly present in the repository. - -As part of the switch to direct mode, any changed files will be committed. - -Note that git commands that operate on the work tree will refuse to -run in direct mode repositories. Use `git annex proxy` to safely run such -commands. - -Note that the direct mode/indirect mode distinction is removed in v7 -git-annex repositories. In such a repository, you can -use [[git-annex-unlock]](1) to make a file's content be directly present. -You can also use [[git-annex-adjust]](1) to enter a branch where all -annexed files are unlocked, which is similar to the old direct mode. +This used to switch a repository to use direct mode. +But direct mode is no longer used; git-annex automatically converts +direct mode repositories to v7 adjusted unlocked branches. # SEE ALSO [[git-annex]](1) [[git-annex-indirect]](1) - -[[git-annex-unlock]](1) [[git-annex-adjust]](1) diff --git a/doc/git-annex-examinekey.mdwn b/doc/git-annex-examinekey.mdwn --- a/doc/git-annex-examinekey.mdwn +++ b/doc/git-annex-examinekey.mdwn @@ -45,8 +45,7 @@ # EXAMPLES -The location a key's value is stored (in indirect mode) -can be looked up by running: +The location where the content of a key is stored can be looked up by running: git annex examinekey $KEY --format='.git/annex/objects/${hashdirmixed}${key}/${key}' diff --git a/doc/git-annex-indirect.mdwn b/doc/git-annex-indirect.mdwn --- a/doc/git-annex-indirect.mdwn +++ b/doc/git-annex-indirect.mdwn @@ -1,6 +1,6 @@ # NAME -git-annex indirect - switch repository to indirect mode +git-annex indirect - switch repository to indirect mode (deprecated) # SYNOPSIS @@ -8,11 +8,11 @@ # DESCRIPTION -Switches a repository back from direct mode to the default, indirect -mode. +This command was used to switch a repository back from direct mode +indirect mode. -Note that the direct mode/indirect mode distinction is removed in v7 -git-annex repositories. +Now git-annex automatically converts direct mode repositories to v7 +with adjusted unlocked branches, so this command does nothing. # SEE ALSO diff --git a/doc/git-annex-pre-commit.mdwn b/doc/git-annex-pre-commit.mdwn --- a/doc/git-annex-pre-commit.mdwn +++ b/doc/git-annex-pre-commit.mdwn @@ -17,9 +17,6 @@ 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-proxy.mdwn b/doc/git-annex-proxy.mdwn --- a/doc/git-annex-proxy.mdwn +++ b/doc/git-annex-proxy.mdwn @@ -1,6 +1,6 @@ # NAME -git-annex proxy - safely bypass direct mode guard +git-annex proxy - safely bypass direct mode guard (deprecated) # SYNOPSIS @@ -8,36 +8,9 @@ # DESCRIPTION -Only useful in a direct mode repository, this runs the specified git -command with a temporary work tree, and updates the working tree to -reflect any changes staged or committed by the git command. - -For example, to revert the most recent change that was committed -to the repository: - - git annex proxy -- git revert HEAD - -To check out a past version of the repository: - - git annex proxy -- git checkout HEAD^^ - -To rename a directory: - - git annex proxy -- git mv mydir newname - -To commit the changes to a specific file, first use git annex add to -stage the changes in the index, and then proxy a commit: - - git annex add myfile - git annex proxy -- git commit myfile -m foo - -The temporary work tree that the git command is run in is set up by -checking out all files that are in the index, and copying (or hard linking) -any unstaged files from the real work tree. Since the git command is run -using this temporary work tree, it won't see eg, local modifications to -files. So, it probably is not useful to proxy a command like "git add". -However, you can use the proxy with any git command you like, as long as -you think about how it will interact with the temporary work tree. +This command was for use in a direct mode repository, and such +repositories are automatically updated to use an adjusted unlocked branch. +So, there's no reason to use this command any longer. # SEE ALSO diff --git a/doc/git-annex-status.mdwn b/doc/git-annex-status.mdwn --- a/doc/git-annex-status.mdwn +++ b/doc/git-annex-status.mdwn @@ -14,8 +14,6 @@ Show files that are not checked into git (?), deleted (D), modified (M), added but not committed (A), and type changed/unlocked (T). -Particularly useful in direct mode. - # OPTIONS * `--ignore-submodules=when` diff --git a/doc/git-annex-unlock.mdwn b/doc/git-annex-unlock.mdwn --- a/doc/git-annex-unlock.mdwn +++ b/doc/git-annex-unlock.mdwn @@ -11,24 +11,26 @@ Normally, the content of annexed files is protected from being changed. Unlocking an annexed file allows it to be modified. This replaces the 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. +The content of an unlocked file is still stored in git-annex, not git, +and when you commit modifications to the file, the modifications will also +be stored in git-annex, with only the pointer file stored in git. + +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 --- 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 @@ # 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 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -100,7 +100,7 @@ * `status [path ...]` Similar to `git status --short`, displays the status of the files in the - working tree. Particularly useful in direct mode. + working tree. See [[git-annex-status]](1) for details. @@ -313,26 +313,25 @@ See [[git-annex-vicfg]](1) for details. +* `adjust` + + Switches a repository to use an adjusted branch, which can automatically + unlock all files, etc. + + See [[git-annex-adjust]](1) for details. + * `direct` - Switches a repository to use direct mode, where rather than symlinks to - files, the files are directly present in the repository. + Switches a repository to use direct mode. (deprecated) See [[git-annex-direct]](1) for details. * `indirect` - Switches a repository back from direct mode to the default, indirect mode. + Switches a repository to use indirect mode. (deprecated) See [[git-annex-indirect]](1) for details. -* `adjust` - - Switches a repository to use an adjusted branch, which can automatically - unlock all files, etc. - - See [[git-annex-adjust]](1) for details. - # REPOSITORY MAINTENANCE COMMANDS * `fsck [path ...]` @@ -384,7 +383,7 @@ * `upgrade` - Upgrades the repository to current layout. + Upgrades the repository. See [[git-annex-upgrade]](1) for details. @@ -665,20 +664,6 @@ See [[git-annex-rekey]](1) for details. -* `findref [ref]` - - Lists files in a git ref. (deprecated) - - See [[git-annex-findref]](1) for details. - -* `proxy -- git cmd [options]` - - Only useful in a direct mode repository, this runs the specified git - command with a temporary work tree, and updates the working tree to - reflect any changes staged or committed by the git command. - - See [[git-annex-proxy]](1) for details. - * `resolvemerge` Resolves a conflicted merge, by adding both conflicting versions of the @@ -708,6 +693,18 @@ See [[git-annex-remotedaemon]](1) for details. +* `findref [ref]` + + Lists files in a git ref. (deprecated) + + See [[git-annex-findref]](1) for details. + +* `proxy -- git cmd [options]` + + Bypass direct mode guard. (deprecated) + + See [[git-annex-proxy]](1) for details. + # TESTING COMMANDS * `test` @@ -839,10 +836,9 @@ 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` @@ -911,7 +907,7 @@ 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. @@ -1047,55 +1043,6 @@ 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, when not using direct mode 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 @@ -1113,33 +1060,26 @@ 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.direct` +* `annex.autoupgraderepository` - Set to true when the repository is in direct mode. Should not be set - manually; use the "git annex direct" and "git annex indirect" commands - instead. + 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` Set to true if the repository is on a crippled filesystem, such as FAT, @@ -1182,6 +1122,27 @@ 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 @@ -1417,6 +1378,91 @@ 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 @@ -1532,111 +1578,72 @@ 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` - - 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`. - -* `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` +# CONFIGURATION OF ASSISTANT - 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. +* `annex.delayadd` -* `remote..annex-s3` + 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. - Used to identify Amazon S3 special remotes. - Normally this is automatically set up by `git annex initremote`. +* `annex.expireunused` -* `remote..annex-glacier` + Controls what the assistant does about unused file contents + that are stored in the repository. - Used to identify Amazon Glacier special remotes. - Normally this is automatically set up by `git annex initremote`. + 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-webdav` + 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 to identify webdav special remotes. - Normally this is automatically set up by `git annex initremote`. +* `annex.fscknudge` -* `remote..annex-tahoe` + When set to false, prevents the webapp from reminding you when using + repositories that lack consistency checks. - Used to identify tahoe special remotes. - Points to the configuration directory for tahoe. +* `annex.autoupgrade` -* `remote..annex-gcrypt` + 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 to identify gcrypt special remotes. - Normally this is automatically set up by `git annex initremote`. + 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. - 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". + 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. -* `remote..annex-git-lfs` +* `annex.autocommit` - Used to identify git-lfs special remotes. - Normally this is automatically set up by `git annex initremote`. + Set to false to prevent the git-annex assistant and git-annex sync + from automatically committing changes to files in the repository. - It is set to "true" if this is a git-lfs remote. + To configure the behavior in all clones of the repository, + this can be set in [[git-annex-config]]. -* `remote..annex-hooktype`, `remote..annex-externaltype` +* `annex.startupscan` - Used by hook special remotes and external special remotes to record - the type of the remote. + 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.tune.objecthash1`, `annex.tune.objecthashlower`, `annex.tune.branchhash1` +* `annex.listen` - 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/git-annex.cabal b/git-annex.cabal --- a/git-annex.cabal +++ b/git-annex.cabal @@ -1,5 +1,5 @@ Name: git-annex -Version: 7.20190819 +Version: 7.20190912 Cabal-Version: >= 1.8 License: AGPL-3 Maintainer: Joey Hess @@ -577,7 +577,7 @@ Assistant.WebApp.RepoList Assistant.WebApp.SideBar Assistant.WebApp.Types - Annex.MakeRepo + Assistant.MakeRepo Utility.Yesod Utility.WebApp @@ -618,13 +618,11 @@ Annex.Common Annex.Concurrent Annex.Content - Annex.Content.Direct Annex.Content.LowLevel Annex.Content.PointerFile Annex.CurrentBranch Annex.Difference Annex.DirHashes - Annex.Direct Annex.Drop Annex.Environment Annex.Export @@ -1011,6 +1009,7 @@ Upgrade.V3 Upgrade.V4 Upgrade.V5 + Upgrade.V5.Direct Upgrade.V6 Utility.Aeson Utility.Android