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.

This commit was sponsored by an anonymous bitcoin donor.
This commit is contained in:
Joey Hess 2013-11-15 14:52:03 -04:00
parent b0f85b3e22
commit d48b00ebed
8 changed files with 56 additions and 41 deletions

View file

@ -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