Fix several places where files in .git/annex/ were written with modes that did not take the core.sharedRepository config into account.

git grep writeFile finds some more that might also be problems, but
for now I've concentrated on .git/annex/ log files. There are certianly
cases where writeFile is not a problem too.

This commit was sponsored by mo on Patreon.

Annex/Transfer.hs

@@ -96,7 +96,7 @@ runTransfer' ignorelock t afile shouldretry transferaction = checkSecureHashes t
 			Nothing -> return (Nothing, True)
 			Just lockhandle -> ifM (checkSaneLock lck lockhandle)
 				( do
-					void $ liftIO $ tryIO $
+					void $ tryIO $
 						writeTransferInfoFile info tfile
 					return (Just lockhandle, False)
 				, do
@@ -111,7 +111,7 @@ runTransfer' ignorelock t afile shouldretry transferaction = checkSecureHashes t
 			Nothing -> return (Nothing, False)
 			Just Nothing -> return (Nothing, True)
 			Just (Just lockhandle) -> do
-				void $ liftIO $ tryIO $
+				void $ tryIO $
 					writeTransferInfoFile info tfile
 				return (Just lockhandle, False)
 #endif

CHANGELOG

@@ -11,8 +11,8 @@ git-annex (6.20171215) UNRELEASED; urgency=medium
   * addurl: Fix encoding of filename queried from youtube-dl when in
     --fast mode.
   * git-annex.cabal: Add back custom-setup stanza, so cabal new-build works.
-  * unused: Write .git/annex/unused etc files with appropriate permissions
-    for the core.sharedRepository config.
+  * Fix several places where files in .git/annex/ were written with modes
+    that did not take the core.sharedRepository config into account.
 
  -- Joey Hess <id@joeyh.name>  Wed, 20 Dec 2017 12:11:46 -0400
 

Command/Fsck.hs

@@ -563,15 +563,15 @@ recordStartTime :: UUID -> Annex ()
 recordStartTime u = do
 	f <- fromRepo (gitAnnexFsckState u)
 	createAnnexDirectory $ parentDir f
-	liftIO $ do
-		nukeFile f
-		withFile f WriteMode $ \h -> do
+	liftIO $ nukeFile f
+	liftIO $ withFile f WriteMode $ \h -> do
 #ifndef mingw32_HOST_OS
-			t <- modificationTime <$> getFileStatus f
+		t <- modificationTime <$> getFileStatus f
 #else
-			t <- getPOSIXTime
+		t <- getPOSIXTime
 #endif
-			hPutStr h $ showTime $ realToFrac t
+		hPutStr h $ showTime $ realToFrac t
+	setAnnexFilePerm f
   where
 	showTime :: POSIXTime -> String
 	showTime = show

Command/FuzzTest.hs

@@ -33,7 +33,7 @@ start = do
 	guardTest
 	logf <- fromRepo gitAnnexFuzzTestLogFile
 	showStart "fuzztest" logf
-	logh <-liftIO $ openFile logf WriteMode
+	logh <- liftIO $ openFile logf WriteMode
 	void $ forever $ fuzz logh
 	stop
 

Command/ImportFeed.hs

@@ -30,10 +30,10 @@ import qualified Remote
 import qualified Types.Remote as Remote
 import Types.UrlContents
 import Logs.Web
+import Logs.File
 import qualified Utility.Format
 import Utility.Tmp
 import Command.AddUrl (addUrlFile, downloadRemoteFile, parseDownloadOptions, DownloadOptions(..))
-import Annex.Perms
 import Annex.UUID
 import Backend.URL (fromUrl)
 import Annex.Content
@@ -386,8 +386,7 @@ checkFeedBroken' url f = do
 	now <- liftIO getCurrentTime
 	case prev of
 		Nothing -> do
-			createAnnexDirectory (parentDir f)
-			liftIO $ writeFile f $ show now
+			writeLogFile f $ show now
 			return False
 		Just prevtime -> do
 			let broken = diffUTCTime now prevtime > 60 * 60 * 23

Logs/File.hs

@@ -0,0 +1,24 @@
+{- git-annex log files
+ -
+ - Copyright 2018 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Logs.File where
+
+import Annex.Common
+import Annex.Perms
+import Utility.Tmp
+
+writeLogFile :: FilePath -> String -> Annex ()
+writeLogFile f c = go `catchNonAsync` \_e -> do
+	-- Most of the time, the directory will exist, so this is only
+	-- done if writing the file fails.
+	createAnnexDirectory (parentDir f)
+	go
+  where
+	go = viaTmp writelog f c
+	writelog f' c' = do
+		liftIO $ writeFile f' c'
+		setAnnexFilePerm f'

Logs/FsckResults.hs

@@ -12,25 +12,22 @@ module Logs.FsckResults (
 ) where
 
 import Annex.Common
-import Utility.Tmp
 import Git.Fsck
 import Git.Types
+import Logs.File
 
 import qualified Data.Set as S
 
 writeFsckResults :: UUID -> FsckResults -> Annex ()
 writeFsckResults u fsckresults = do
 	logfile <- fromRepo $ gitAnnexFsckResultsLog u
-	liftIO $ 
-		case fsckresults of
-			FsckFailed -> store S.empty False logfile
-			FsckFoundMissing s t
-				| S.null s -> nukeFile logfile
-				| otherwise -> store s t logfile
+	case fsckresults of
+		FsckFailed -> store S.empty False logfile
+		FsckFoundMissing s t
+			| S.null s -> liftIO $ nukeFile logfile
+			| otherwise -> store s t logfile
   where
-	store s t logfile = do 
-		createDirectoryIfMissing True (parentDir logfile)
-		liftIO $ viaTmp writeFile logfile $ serialize s t
+	store s t logfile = writeLogFile logfile $ serialize s t
 	serialize s t =
 		let ls = map fromRef (S.toList s)
 		in if t

Logs/Schedule.hs

@@ -26,7 +26,7 @@ import Types.ScheduledActivity
 import qualified Annex.Branch
 import Logs
 import Logs.UUIDBased
-import Utility.Tmp
+import Logs.File
 
 scheduleSet :: UUID -> [ScheduledActivity] -> Annex ()
 scheduleSet uuid@(UUID _) activities = do
@@ -67,5 +67,5 @@ getLastRunTimes = do
 setLastRunTime :: ScheduledActivity -> LocalTime -> Annex ()
 setLastRunTime activity lastrun = do
 	f <- fromRepo gitAnnexScheduleState
-	liftIO . viaTmp writeFile f . show . M.insert activity lastrun
+	writeLogFile f . show . M.insert activity lastrun
 		=<< getLastRunTimes

Logs/Transfer.hs

@@ -19,6 +19,7 @@ import Utility.Percentage
 import Utility.PID
 import Annex.LockPool
 import Logs.TimeStamp
+import Logs.File
 
 import Data.Time.Clock
 import Data.Time.Clock.POSIX
@@ -51,7 +52,7 @@ percentComplete (Transfer { transferKey = key }) info =
 mkProgressUpdater :: Transfer -> TransferInfo -> Annex (MeterUpdate, FilePath, MVar Integer)
 mkProgressUpdater t info = do
 	tfile <- fromRepo $ transferFile t
-	_ <- tryNonAsync $ createAnnexDirectory $ takeDirectory tfile
+	_ <- tryNonAsync $ writeTransferInfoFile info tfile
 	mvar <- liftIO $ newMVar 0
 	return (liftIO . updater tfile mvar, tfile, mvar)
   where
@@ -60,7 +61,7 @@ mkProgressUpdater t info = do
 		if newbytes - oldbytes >= mindelta
 			then do
 				let info' = info { bytesComplete = Just newbytes }
-				_ <- tryIO $ writeTransferInfoFile info' tfile
+				_ <- tryIO $ updateTransferInfoFile info' tfile
 				return newbytes
 			else return oldbytes
 	{- The minimum change in bytesComplete that is worth
@@ -181,8 +182,7 @@ removeFailedTransfer t = do
 recordFailedTransfer :: Transfer -> TransferInfo -> Annex ()
 recordFailedTransfer t info = do
 	failedtfile <- fromRepo $ failedTransferFile t
-	createAnnexDirectory $ takeDirectory failedtfile
-	liftIO $ writeTransferInfoFile info failedtfile
+	writeTransferInfoFile info failedtfile
 
 {- The transfer information file to use for a given Transfer. -}
 transferFile :: Transfer -> Git.Repo -> FilePath
@@ -213,8 +213,13 @@ parseTransferFile file
   where
 	bits = splitDirectories file
 
-writeTransferInfoFile :: TransferInfo -> FilePath -> IO ()
-writeTransferInfoFile info tfile = writeFile tfile $ writeTransferInfo info
+writeTransferInfoFile :: TransferInfo -> FilePath -> Annex ()
+writeTransferInfoFile info tfile = writeLogFile tfile $ writeTransferInfo info
+
+-- The file keeps whatever permissions it has, so should be used only
+-- after it's been created with the right perms by writeTransferInfoFile.
+updateTransferInfoFile :: TransferInfo -> FilePath -> IO ()
+updateTransferInfoFile info tfile = writeFile tfile $ writeTransferInfo info
 
 {- File format is a header line containing the startedTime and any
  - bytesComplete value. Followed by a newline and the associatedFile.

Logs/Unused.hs

@@ -33,9 +33,8 @@ import Data.Time
 
 import Annex.Common
 import qualified Annex
-import Annex.Perms
-import Utility.Tmp
 import Logs.TimeStamp
+import Logs.File
 
 -- everything that is stored in the unused log
 type UnusedLog = M.Map Key (Int, Maybe POSIXTime)
@@ -65,13 +64,10 @@ updateUnusedLog prefix m = do
 writeUnusedLog :: FilePath -> UnusedLog -> Annex ()
 writeUnusedLog prefix l = do
 	logfile <- fromRepo $ gitAnnexUnusedLog prefix
-	viaTmp writelog logfile $ unlines $ map format $ M.toList l
+	writeLogFile logfile $ unlines $ map format $ M.toList l
   where
 	format (k, (i, Just t)) = show i ++ " " ++ key2file k ++ " " ++ show t
 	format (k, (i, Nothing)) = show i ++ " " ++ key2file k
-	writelog f c = do
-		liftIO $ writeFile f c
-		setAnnexFilePerm f
 
 readUnusedLog :: FilePath -> Annex UnusedLog
 readUnusedLog prefix = do

Logs/View.hs

@@ -26,7 +26,7 @@ import qualified Git
 import qualified Git.Branch
 import qualified Git.Ref
 import Git.Types
-import Utility.Tmp
+import Logs.File
 
 import qualified Data.Set as S
 import Data.Char
@@ -39,7 +39,7 @@ setView v = do
 writeViews :: [View] -> Annex ()
 writeViews l = do
 	f <- fromRepo gitAnnexViewLog
-	liftIO $ viaTmp writeFile f $ unlines $ map show l
+	writeLogFile f $ unlines $ map show l
 
 removeView :: View -> Annex ()
 removeView v = writeViews =<< filter (/= v) <$> recentViews

git-annex.cabal

@@ -860,6 +860,7 @@ Executable git-annex
     Logs.Difference
     Logs.Difference.Pure
     Logs.Export
+    Logs.File
     Logs.FsckResults
     Logs.Group
     Logs.Line