From 6d58ca94d6419a3cb6f052ceada90fe82f2c9aff Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 5 Mar 2020 14:56:47 -0400 Subject: [PATCH] some easy createDirectoryUnder conversions --- Annex/AdjustedBranch.hs | 11 ++++++----- Annex/ChangedRefs.hs | 5 +++-- Annex/Content.hs | 3 +-- Assistant.hs | 1 + Config/Smudge.hs | 3 ++- Database/Init.hs | 8 +++++--- Remote/Directory.hs | 18 +++++++++--------- Remote/Directory/LegacyChunked.hs | 10 +++++----- Remote/GCrypt.hs | 2 +- Remote/Helper/Hooks.hs | 2 +- Utility/Daemon.hs | 1 - ...2_1633fecf3fd5096c1bfcf77dfe471189._comment | 10 ++++++++++ 12 files changed, 44 insertions(+), 30 deletions(-) create mode 100644 doc/todo/stop_using_createDirectoryIfMissing_True/comment_2_1633fecf3fd5096c1bfcf77dfe471189._comment diff --git a/Annex/AdjustedBranch.hs b/Annex/AdjustedBranch.hs index 7f623c4139..841d1f2756 100644 --- a/Annex/AdjustedBranch.hs +++ b/Annex/AdjustedBranch.hs @@ -57,6 +57,7 @@ import Annex.Tmp import Annex.GitOverlay import Utility.Tmp.Dir import Utility.CopyFile +import Utility.Directory import qualified Database.Keys import Config @@ -375,10 +376,10 @@ mergeToAdjustedBranch tomerge (origbranch, adj) mergeconfig canresolvemerge comm - index file is currently locked.) -} changestomerge (Just updatedorig) = withOtherTmp $ \othertmpdir -> do - tmpwt <- fromRepo gitAnnexMergeDir git_dir <- fromRawFilePath <$> fromRepo Git.localGitDir + tmpwt <- fromRepo gitAnnexMergeDir withTmpDirIn othertmpdir "git" $ \tmpgit -> withWorkTreeRelated tmpgit $ - withemptydir tmpwt $ withWorkTree tmpwt $ do + withemptydir git_dir tmpwt $ withWorkTree tmpwt $ do liftIO $ writeFile (tmpgit "HEAD") (fromRef updatedorig) -- Copy in refs and packed-refs, to work -- around bug in git 2.13.0, which @@ -390,7 +391,7 @@ mergeToAdjustedBranch tomerge (origbranch, adj) mergeconfig canresolvemerge comm whenM (doesFileExist src) $ do dest <- relPathDirToFile git_dir src let dest' = tmpgit dest - createDirectoryIfMissing True (takeDirectory dest') + createDirectoryUnder git_dir (takeDirectory dest') void $ createLinkOrCopy src dest' -- This reset makes git merge not care -- that the work tree is empty; otherwise @@ -411,12 +412,12 @@ mergeToAdjustedBranch tomerge (origbranch, adj) mergeconfig canresolvemerge comm else return $ return False changestomerge Nothing = return $ return False - withemptydir d a = bracketIO setup cleanup (const a) + withemptydir git_dir d a = bracketIO setup cleanup (const a) where setup = do whenM (doesDirectoryExist d) $ removeDirectoryRecursive d - createDirectoryIfMissing True d + createDirectoryUnder git_dir d cleanup _ = removeDirectoryRecursive d {- A merge commit has been made between the basisbranch and diff --git a/Annex/ChangedRefs.hs b/Annex/ChangedRefs.hs index 6b6be4d202..786a193e55 100644 --- a/Annex/ChangedRefs.hs +++ b/Annex/ChangedRefs.hs @@ -76,8 +76,9 @@ watchChangedRefs = do chan <- liftIO $ newTBMChanIO 100 g <- gitRepo - let refdir = fromRawFilePath (Git.localGitDir g) "refs" - liftIO $ createDirectoryIfMissing True refdir + let gittop = fromRawFilePath (Git.localGitDir g) + let refdir = gittop "refs" + liftIO $ createDirectoryUnder gittop refdir let notifyhook = Just $ notifyHook chan let hooks = mkWatchHooks diff --git a/Annex/Content.hs b/Annex/Content.hs index 9615513669..84383c192b 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -879,8 +879,7 @@ withTmpWorkDir key action = do liftIO $ writeFile obj "" setAnnexFilePerm obj let tmpdir = gitAnnexTmpWorkDir obj - liftIO $ createDirectoryIfMissing True tmpdir - setAnnexDirPerm tmpdir + createAnnexDirectory tmpdir res <- action tmpdir case res of Just _ -> liftIO $ removeDirectoryRecursive tmpdir diff --git a/Assistant.hs b/Assistant.hs index 037dd19c91..26569836d1 100644 --- a/Assistant.hs +++ b/Assistant.hs @@ -75,6 +75,7 @@ startDaemon assistant foreground startdelay cannotrun listenhost startbrowser = pidfile <- fromRepo gitAnnexPidFile logfile <- fromRepo gitAnnexLogFile liftIO $ debugM desc $ "logging to " ++ logfile + createAnnexDirectory (parentDir pidfile) #ifndef mingw32_HOST_OS createAnnexDirectory (parentDir logfile) logfd <- liftIO $ handleToFd =<< openLog logfile diff --git a/Config/Smudge.hs b/Config/Smudge.hs index 9b104a7650..9f4cf85060 100644 --- a/Config/Smudge.hs +++ b/Config/Smudge.hs @@ -33,8 +33,9 @@ configureSmudgeFilter = unlessM (fromRepo Git.repoIsLocalBare) $ do gf <- Annex.fromRepo Git.attributes lfs <- readattr lf gfs <- readattr gf + gittop <- fromRawFilePath . Git.localGitDir <$> gitRepo liftIO $ unless ("filter=annex" `isInfixOf` (lfs ++ gfs)) $ do - createDirectoryIfMissing True (takeDirectory lf) + createDirectoryUnder gittop (takeDirectory lf) writeFile lf (lfs ++ "\n" ++ unlines stdattr) where readattr = liftIO . catchDefaultIO "" . readFileStrict diff --git a/Database/Init.hs b/Database/Init.hs index f250329887..3744de6582 100644 --- a/Database/Init.hs +++ b/Database/Init.hs @@ -1,6 +1,6 @@ {- Persistent sqlite database initialization - - - Copyright 2015-2018 Joey Hess + - Copyright 2015-2020 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -10,6 +10,7 @@ module Database.Init where import Annex.Common import Annex.Perms import Utility.FileMode +import Utility.Directory import Database.Persist.Sqlite import Control.Monad.IO.Class (liftIO) @@ -29,9 +30,10 @@ initDb db migration = do let dbdir = takeDirectory db let tmpdbdir = dbdir ++ ".tmp" let tmpdb = tmpdbdir "db" - let tdb = T.pack tmpdb + let tdb = T.pack tmpdb + top <- parentDir . fromRawFilePath <$> fromRepo gitAnnexDir liftIO $ do - createDirectoryIfMissing True tmpdbdir + createDirectoryUnder top tmpdbdir runSqliteInfo (enableWAL tdb) migration setAnnexDirPerm tmpdbdir -- Work around sqlite bug that prevents it from honoring diff --git a/Remote/Directory.hs b/Remote/Directory.hs index bf83cc8476..60247d19cc 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -170,13 +170,13 @@ checkDiskSpaceDirectory d k = do store :: FilePath -> ChunkConfig -> Key -> L.ByteString -> MeterUpdate -> Annex Bool store d chunkconfig k b p = liftIO $ do - void $ tryIO $ createDirectoryIfMissing True tmpdir + void $ tryIO $ createDirectoryUnder d tmpdir case chunkconfig of - LegacyChunks chunksize -> Legacy.store chunksize finalizeStoreGeneric k b p tmpdir destdir + LegacyChunks chunksize -> Legacy.store d chunksize (finalizeStoreGeneric d) k b p tmpdir destdir _ -> do let tmpf = tmpdir kf meteredWriteFile p tmpf b - finalizeStoreGeneric tmpdir destdir + finalizeStoreGeneric d tmpdir destdir return True where tmpdir = addTrailingPathSeparator $ d "tmp" kf @@ -187,11 +187,11 @@ store d chunkconfig k b p = liftIO $ do - in the dest directory, moves it into place. Anything already existing - in the dest directory will be deleted. File permissions will be locked - down. -} -finalizeStoreGeneric :: FilePath -> FilePath -> IO () -finalizeStoreGeneric tmp dest = do +finalizeStoreGeneric :: FilePath -> FilePath -> FilePath -> IO () +finalizeStoreGeneric d tmp dest = do void $ tryIO $ allowWrite dest -- may already exist void $ tryIO $ removeDirectoryRecursive dest -- or not exist - createDirectoryIfMissing True (parentDir dest) + createDirectoryUnder d (parentDir dest) renameDirectory tmp dest -- may fail on some filesystems void $ tryIO $ do @@ -267,7 +267,7 @@ checkPresentGeneric' d check = ifM check storeExportM :: FilePath -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex Bool storeExportM d src _k loc p = liftIO $ catchBoolIO $ do - createDirectoryIfMissing True (takeDirectory dest) + createDirectoryUnder d (takeDirectory dest) -- Write via temp file so that checkPresentGeneric will not -- see it until it's fully stored. viaTmp (\tmp () -> withMeteredFile src p (L.writeFile tmp)) dest () @@ -298,7 +298,7 @@ renameExportM :: FilePath -> Key -> ExportLocation -> ExportLocation -> Annex (M renameExportM d _k oldloc newloc = liftIO $ Just <$> go where go = catchBoolIO $ do - createDirectoryIfMissing True (takeDirectory dest) + createDirectoryUnder d (takeDirectory dest) renameFile src dest removeExportLocation d oldloc return True @@ -413,7 +413,7 @@ storeExportWithContentIdentifierM dir src _k loc overwritablecids p = catchIO go (return . Left . show) where go = do - liftIO $ createDirectoryIfMissing True destdir + liftIO $ createDirectoryUnder dir destdir withTmpFileIn destdir template $ \tmpf tmph -> do liftIO $ withMeteredFile src p (L.hPut tmph) liftIO $ hFlush tmph diff --git a/Remote/Directory/LegacyChunked.hs b/Remote/Directory/LegacyChunked.hs index d9d5a860ce..0943f63234 100644 --- a/Remote/Directory/LegacyChunked.hs +++ b/Remote/Directory/LegacyChunked.hs @@ -70,9 +70,9 @@ storeLegacyChunked' meterupdate chunksize (d:dests) bs c = do feed bytes' (sz - s) ls h else return (l:ls) -storeHelper :: (FilePath -> FilePath -> IO ()) -> Key -> ([FilePath] -> IO [FilePath]) -> FilePath -> FilePath -> IO Bool -storeHelper finalizer key storer tmpdir destdir = do - void $ liftIO $ tryIO $ createDirectoryIfMissing True tmpdir +storeHelper :: FilePath -> (FilePath -> FilePath -> IO ()) -> Key -> ([FilePath] -> IO [FilePath]) -> FilePath -> FilePath -> IO Bool +storeHelper repotop finalizer key storer tmpdir destdir = do + void $ liftIO $ tryIO $ createDirectoryUnder repotop tmpdir Legacy.storeChunks key tmpdir destdir storer recorder finalizer where recorder f s = do @@ -80,8 +80,8 @@ storeHelper finalizer key storer tmpdir destdir = do writeFile f s void $ tryIO $ preventWrite f -store :: ChunkSize -> (FilePath -> FilePath -> IO ()) -> Key -> L.ByteString -> MeterUpdate -> FilePath -> FilePath -> IO Bool -store chunksize finalizer k b p = storeHelper finalizer k $ \dests -> +store :: FilePath -> ChunkSize -> (FilePath -> FilePath -> IO ()) -> Key -> L.ByteString -> MeterUpdate -> FilePath -> FilePath -> IO Bool +store repotop chunksize finalizer k b p = storeHelper repotop finalizer k $ \dests -> storeLegacyChunked p chunksize dests b {- Need to get a single ByteString containing every chunk. diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs index 1b60638b94..a50d949d26 100644 --- a/Remote/GCrypt.hs +++ b/Remote/GCrypt.hs @@ -372,7 +372,7 @@ store' repo r rsyncopts let tmpf = tmpdir fromRawFilePath (keyFile k) meteredWriteFile p tmpf b let destdir = parentDir $ gCryptLocation repo k - Remote.Directory.finalizeStoreGeneric tmpdir destdir + Remote.Directory.finalizeStoreGeneric (Git.repoLocation repo) tmpdir destdir return True | Git.repoIsSsh repo = if accessShell r then fileStorer $ \k f p -> do diff --git a/Remote/Helper/Hooks.hs b/Remote/Helper/Hooks.hs index 7b6ae77368..5d23e0c06b 100644 --- a/Remote/Helper/Hooks.hs +++ b/Remote/Helper/Hooks.hs @@ -48,7 +48,7 @@ runHooks r starthook stophook a = do dir <- fromRepo gitAnnexRemotesDir let lck = dir remoteid ++ ".lck" whenM (notElem lck . M.keys <$> getLockCache) $ do - liftIO $ createDirectoryIfMissing True dir + createAnnexDirectory dir firstrun lck a where diff --git a/Utility/Daemon.hs b/Utility/Daemon.hs index d4f060e6bb..2e1a9baa8f 100644 --- a/Utility/Daemon.hs +++ b/Utility/Daemon.hs @@ -90,7 +90,6 @@ foreground pidfile a = do - Fails if the pid file is already locked by another process. -} lockPidFile :: FilePath -> IO () lockPidFile pidfile = do - createDirectoryIfMissing True (parentDir pidfile) #ifndef mingw32_HOST_OS fd <- openFd pidfile ReadWrite (Just stdFileMode) defaultFileFlags locked <- catchMaybeIO $ setLock fd (WriteLock, AbsoluteSeek, 0, 0) diff --git a/doc/todo/stop_using_createDirectoryIfMissing_True/comment_2_1633fecf3fd5096c1bfcf77dfe471189._comment b/doc/todo/stop_using_createDirectoryIfMissing_True/comment_2_1633fecf3fd5096c1bfcf77dfe471189._comment new file mode 100644 index 0000000000..c6dc45fe00 --- /dev/null +++ b/doc/todo/stop_using_createDirectoryIfMissing_True/comment_2_1633fecf3fd5096c1bfcf77dfe471189._comment @@ -0,0 +1,10 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 2""" + date="2020-03-05T19:18:31Z" + content=""" +Most of the easy ones have been converted now. + +There's one in Annex.ReplaceFile that's hard, and is probably the only +important one left unconverted. +"""]]