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.

1 files changed, 12 insertions, 0 deletions

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