summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Annex/Content.hs28
-rw-r--r--Annex/Content/Direct.hs26
-rw-r--r--Annex/Direct.hs6
-rw-r--r--Annex/Perms.hs12
-rw-r--r--Command/Fsck.hs5
-rw-r--r--Command/Indirect.hs13
-rw-r--r--debian/changelog4
-rw-r--r--doc/bugs/Incorrect_merge___40__a_special_case__41__.mdwn3
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]]