diff options
-rw-r--r-- | Annex/Content.hs | 28 | ||||
-rw-r--r-- | Annex/Content/Direct.hs | 26 | ||||
-rw-r--r-- | Annex/Direct.hs | 6 | ||||
-rw-r--r-- | Annex/Perms.hs | 12 | ||||
-rw-r--r-- | Command/Fsck.hs | 5 | ||||
-rw-r--r-- | Command/Indirect.hs | 13 | ||||
-rw-r--r-- | debian/changelog | 4 | ||||
-rw-r--r-- | doc/bugs/Incorrect_merge___40__a_special_case__41__.mdwn | 3 |
8 files changed, 56 insertions, 41 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs index 66ca7be18..5ce0f2689 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -29,7 +29,6 @@ module Annex.Content ( preseedTmp, freezeContent, thawContent, - cleanObjectLoc, dirKeys, ) where @@ -255,11 +254,9 @@ moveAnnex key src = withObjectLoc key storeobject storedirect where storeobject dest = ifM (liftIO $ doesFileExist dest) ( alreadyhave - , do - createContentDir dest + , modifyContent dest $ do liftIO $ moveFile src dest freezeContent dest - freezeContentDir dest ) storeindirect = storeobject =<< calcRepo (gitAnnexLocation key) @@ -273,7 +270,6 @@ moveAnnex key src = withObjectLoc key storeobject storedirect storedirect = storedirect' storeindirect storedirect' fallback [] = fallback storedirect' fallback (f:fs) = do - thawContentDir =<< calcRepo (gitAnnexLocation key) thawContent src v <- isAnnexLink f if Just key == v @@ -349,11 +345,11 @@ withObjectLoc key indirect direct = ifM isDirect where goindirect = indirect =<< calcRepo (gitAnnexLocation key) -cleanObjectLoc :: Key -> Annex () -cleanObjectLoc key = do +cleanObjectLoc :: Key -> Annex () -> Annex () +cleanObjectLoc key cleaner = do file <- calcRepo $ gitAnnexLocation key - unlessM crippledFileSystem $ - void $ liftIO $ catchMaybeIO $ allowWrite $ parentDir file + void $ tryAnnexIO $ thawContentDir file + cleaner liftIO $ removeparents file (3 :: Int) where removeparents _ 0 = noop @@ -369,13 +365,10 @@ cleanObjectLoc key = do removeAnnex :: Key -> Annex () removeAnnex key = withObjectLoc key remove removedirect where - remove file = do - thawContentDir file + remove file = cleanObjectLoc key $ do liftIO $ nukeFile file removeInodeCache key - cleanObjectLoc key removedirect fs = do - thawContentDir =<< calcRepo (gitAnnexLocation key) cache <- recordedInodeCache key removeInodeCache key mapM_ (resetfile cache) fs @@ -389,12 +382,10 @@ removeAnnex key = withObjectLoc key remove removedirect {- Moves a key's file out of .git/annex/objects/ -} fromAnnex :: Key -> FilePath -> Annex () -fromAnnex key dest = do +fromAnnex key dest = cleanObjectLoc key $ do file <- calcRepo $ gitAnnexLocation key - thawContentDir file thawContent file liftIO $ moveFile file dest - cleanObjectLoc key {- Moves a key out of .git/annex/objects/ into .git/annex/bad, and - returns the file it was moved to. -} @@ -404,9 +395,8 @@ moveBad key = do bad <- fromRepo gitAnnexBadDir let dest = bad </> takeFileName src createAnnexDirectory (parentDir dest) - thawContentDir src - liftIO $ moveFile src dest - cleanObjectLoc key + cleanObjectLoc key $ + liftIO $ moveFile src dest logStatus key InfoMissing return dest diff --git a/Annex/Content/Direct.hs b/Annex/Content/Direct.hs index b0b8621e9..a5d71288b 100644 --- a/Annex/Content/Direct.hs +++ b/Annex/Content/Direct.hs @@ -10,6 +10,7 @@ module Annex.Content.Direct ( associatedFilesRelative, removeAssociatedFile, removeAssociatedFileUnchecked, + removeAssociatedFiles, addAssociatedFile, goodContent, recordedInodeCache, @@ -64,8 +65,8 @@ changeAssociatedFiles key transform = do files <- associatedFilesRelative key let files' = transform files when (files /= files') $ do - createContentDir mapping - liftIO $ viaTmp write mapping $ unlines files' + modifyContent mapping $ + liftIO $ viaTmp write mapping $ unlines files' top <- fromRepo Git.repoPath return $ map (top </>) files' where @@ -75,6 +76,13 @@ changeAssociatedFiles key transform = do hPutStr h content hClose h +{- 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. -} @@ -142,16 +150,16 @@ addInodeCache key cache = do {- Writes inode cache for a key. -} writeInodeCache :: Key -> [InodeCache] -> Annex () -writeInodeCache key caches = withInodeCacheFile key $ \f -> do - createContentDir f - liftIO $ writeFile f $ - unlines $ map showInodeCache caches +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 -> do - createContentDir f -- also thaws directory - liftIO $ nukeFile f +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/Annex/Direct.hs b/Annex/Direct.hs index 366966fc2..3fa5f9362 100644 --- a/Annex/Direct.hs +++ b/Annex/Direct.hs @@ -210,11 +210,11 @@ toDirectGen k f = do where fromindirect loc = do {- Move content from annex to direct file. -} - thawContentDir loc updateInodeCache k loc void $ addAssociatedFile k f - thawContent loc - replaceFile f $ liftIO . moveFile loc + modifyContent loc $ do + thawContent loc + replaceFile f $ liftIO . moveFile loc fromdirect loc = do replaceFile f $ liftIO . void . copyFileExternal loc diff --git a/Annex/Perms.hs b/Annex/Perms.hs index f5925b741..9ce0fe2a6 100644 --- a/Annex/Perms.hs +++ b/Annex/Perms.hs @@ -13,12 +13,14 @@ module Annex.Perms ( createContentDir, freezeContentDir, thawContentDir, + modifyContent, ) where import Common.Annex import Utility.FileMode import Git.SharedRepository import qualified Annex +import Annex.Exception import Config import System.Posix.Types @@ -103,3 +105,13 @@ createContentDir dest = do liftIO $ allowWrite dir where dir = parentDir dest + +{- Creates the content directory for a file if it doesn't already exist, + - or thaws it if it does, then runs an action to modify the file, and + - finally, freezes the content directory. -} +modifyContent :: FilePath -> Annex a -> Annex a +modifyContent f a = do + createContentDir f -- also thaws it + v <- tryAnnex a + freezeContentDir f + either throwAnnex return v diff --git a/Command/Fsck.hs b/Command/Fsck.hs index 3b89c550c..a8e52af98 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -218,9 +218,10 @@ verifyLocationLog key desc = do {- Since we're checking that a key's file is present, throw - in a permission fixup here too. -} - when (present && not direct) $ do - file <- calcRepo $ gitAnnexLocation key + file <- calcRepo $ gitAnnexLocation key + when (present && not direct) $ freezeContent file + whenM (liftIO $ doesDirectoryExist $ parentDir file) $ freezeContentDir file {- In direct mode, modified files will show up as not present, diff --git a/Command/Indirect.hs b/Command/Indirect.hs index a2512ea96..8b857e2f6 100644 --- a/Command/Indirect.hs +++ b/Command/Indirect.hs @@ -20,9 +20,9 @@ import Config import qualified Annex import Annex.Direct import Annex.Content +import Annex.Content.Direct import Annex.CatFile import Annex.Version -import Annex.Perms import Annex.Exception import Init import qualified Command.Add @@ -77,7 +77,8 @@ perform = do Just s | isSymbolicLink s -> void $ flip whenAnnexed f $ \_ (k, _) -> do - cleandirect k + removeInodeCache k + removeAssociatedFiles k return Nothing | otherwise -> maybe noop (fromdirect f) @@ -87,8 +88,8 @@ perform = do fromdirect f k = do showStart "indirect" f - thawContentDir =<< calcRepo (gitAnnexLocation k) - cleandirect k -- clean before content directory gets frozen + removeInodeCache k + removeAssociatedFiles k whenM (liftIO $ not . isSymbolicLink <$> getSymbolicLinkStatus f) $ do v <-tryAnnexIO (moveAnnex k f) case v of @@ -103,10 +104,6 @@ perform = do warnlocked e = do warning $ show e warning "leaving this file as-is; correct this problem and run git annex add on it" - - cleandirect k = do - liftIO . nukeFile =<< calcRepo (gitAnnexInodeCache k) - liftIO . nukeFile =<< calcRepo (gitAnnexMapping k) cleanup :: CommandCleanup cleanup = do diff --git a/debian/changelog b/debian/changelog index 86e833eab..4f1e766ab 100644 --- a/debian/changelog +++ b/debian/changelog @@ -31,6 +31,10 @@ git-annex (5.20131102) UNRELEASED; urgency=low with a directory. An ordering problem caused the directory to not get created in this case. Thanks to Tim for the test cases. + * Direct mode .git/annex/objects directories are no longer left writable, + because that allowed writing to symlinks of files that are not present, + which followed the link and put bad content in an object location. + * fsck: Fix up .git/annex/object directory permissions. -- Joey Hess <joeyh@debian.org> Wed, 06 Nov 2013 16:14:14 -0400 diff --git a/doc/bugs/Incorrect_merge___40__a_special_case__41__.mdwn b/doc/bugs/Incorrect_merge___40__a_special_case__41__.mdwn index 5b817e214..8e25ed6cb 100644 --- a/doc/bugs/Incorrect_merge___40__a_special_case__41__.mdwn +++ b/doc/bugs/Incorrect_merge___40__a_special_case__41__.mdwn @@ -43,3 +43,6 @@ remote types: git gcrypt S3 bup directory rsync web webdav glacier hook Linux ceilingcat 3.11.6-1-ARCH #1 SMP PREEMPT Fri Oct 18 23:22:36 CEST 2013 x86_64 GNU/Linux """]] + +> [[fixed|done]]; direct mode now freezes the content directory as indirect +> mode already did. fsck will fix up the permissions too. --[[Joey]] |