From ed2c1839fd8e0616165de569cff939dc3bf6527d Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 2 Jan 2018 17:17:10 -0400 Subject: 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 | 4 ++-- CHANGELOG | 4 ++-- Command/Fsck.hs | 12 ++++++------ Command/FuzzTest.hs | 2 +- Command/ImportFeed.hs | 5 ++--- Logs/File.hs | 24 ++++++++++++++++++++++++ Logs/FsckResults.hs | 17 +++++++---------- Logs/Schedule.hs | 4 ++-- Logs/Transfer.hs | 17 +++++++++++------ Logs/Unused.hs | 8 ++------ Logs/View.hs | 4 ++-- git-annex.cabal | 1 + 12 files changed, 62 insertions(+), 40 deletions(-) create mode 100644 Logs/File.hs diff --git a/Annex/Transfer.hs b/Annex/Transfer.hs index ad617a7df..0d013d411 100644 --- a/Annex/Transfer.hs +++ b/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 diff --git a/CHANGELOG b/CHANGELOG index 75111164b..15698ae5b 100644 --- a/CHANGELOG +++ b/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 Wed, 20 Dec 2017 12:11:46 -0400 diff --git a/Command/Fsck.hs b/Command/Fsck.hs index 7884f0477..2db6e279d 100644 --- a/Command/Fsck.hs +++ b/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 diff --git a/Command/FuzzTest.hs b/Command/FuzzTest.hs index 0c5aac9b3..fd650facf 100644 --- a/Command/FuzzTest.hs +++ b/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 diff --git a/Command/ImportFeed.hs b/Command/ImportFeed.hs index a02d11824..1dee48454 100644 --- a/Command/ImportFeed.hs +++ b/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 diff --git a/Logs/File.hs b/Logs/File.hs new file mode 100644 index 000000000..c93b21e4d --- /dev/null +++ b/Logs/File.hs @@ -0,0 +1,24 @@ +{- git-annex log files + - + - Copyright 2018 Joey Hess + - + - 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' diff --git a/Logs/FsckResults.hs b/Logs/FsckResults.hs index 09430e806..296847fa4 100644 --- a/Logs/FsckResults.hs +++ b/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 diff --git a/Logs/Schedule.hs b/Logs/Schedule.hs index aea0df223..1868e3460 100644 --- a/Logs/Schedule.hs +++ b/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 diff --git a/Logs/Transfer.hs b/Logs/Transfer.hs index 3e90ae1ee..9413f703b 100644 --- a/Logs/Transfer.hs +++ b/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. diff --git a/Logs/Unused.hs b/Logs/Unused.hs index 076245591..d76d19a56 100644 --- a/Logs/Unused.hs +++ b/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 diff --git a/Logs/View.hs b/Logs/View.hs index 00bdb3079..80bdcc2a9 100644 --- a/Logs/View.hs +++ b/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 diff --git a/git-annex.cabal b/git-annex.cabal index d5178e858..0053a63e5 100644 --- a/git-annex.cabal +++ b/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 -- cgit v1.2.3