some easy createDirectoryUnder conversions

This commit is contained in:
Joey Hess 2020-03-05 14:56:47 -04:00
parent ebbc5004fa
commit 6d58ca94d6
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
12 changed files with 44 additions and 30 deletions

View file

@ -57,6 +57,7 @@ import Annex.Tmp
import Annex.GitOverlay import Annex.GitOverlay
import Utility.Tmp.Dir import Utility.Tmp.Dir
import Utility.CopyFile import Utility.CopyFile
import Utility.Directory
import qualified Database.Keys import qualified Database.Keys
import Config import Config
@ -375,10 +376,10 @@ mergeToAdjustedBranch tomerge (origbranch, adj) mergeconfig canresolvemerge comm
- index file is currently locked.) - index file is currently locked.)
-} -}
changestomerge (Just updatedorig) = withOtherTmp $ \othertmpdir -> do changestomerge (Just updatedorig) = withOtherTmp $ \othertmpdir -> do
tmpwt <- fromRepo gitAnnexMergeDir
git_dir <- fromRawFilePath <$> fromRepo Git.localGitDir git_dir <- fromRawFilePath <$> fromRepo Git.localGitDir
tmpwt <- fromRepo gitAnnexMergeDir
withTmpDirIn othertmpdir "git" $ \tmpgit -> withWorkTreeRelated tmpgit $ withTmpDirIn othertmpdir "git" $ \tmpgit -> withWorkTreeRelated tmpgit $
withemptydir tmpwt $ withWorkTree tmpwt $ do withemptydir git_dir tmpwt $ withWorkTree tmpwt $ do
liftIO $ writeFile (tmpgit </> "HEAD") (fromRef updatedorig) liftIO $ writeFile (tmpgit </> "HEAD") (fromRef updatedorig)
-- Copy in refs and packed-refs, to work -- Copy in refs and packed-refs, to work
-- around bug in git 2.13.0, which -- around bug in git 2.13.0, which
@ -390,7 +391,7 @@ mergeToAdjustedBranch tomerge (origbranch, adj) mergeconfig canresolvemerge comm
whenM (doesFileExist src) $ do whenM (doesFileExist src) $ do
dest <- relPathDirToFile git_dir src dest <- relPathDirToFile git_dir src
let dest' = tmpgit </> dest let dest' = tmpgit </> dest
createDirectoryIfMissing True (takeDirectory dest') createDirectoryUnder git_dir (takeDirectory dest')
void $ createLinkOrCopy src dest' void $ createLinkOrCopy src dest'
-- This reset makes git merge not care -- This reset makes git merge not care
-- that the work tree is empty; otherwise -- that the work tree is empty; otherwise
@ -411,12 +412,12 @@ mergeToAdjustedBranch tomerge (origbranch, adj) mergeconfig canresolvemerge comm
else return $ return False else return $ return False
changestomerge Nothing = 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 where
setup = do setup = do
whenM (doesDirectoryExist d) $ whenM (doesDirectoryExist d) $
removeDirectoryRecursive d removeDirectoryRecursive d
createDirectoryIfMissing True d createDirectoryUnder git_dir d
cleanup _ = removeDirectoryRecursive d cleanup _ = removeDirectoryRecursive d
{- A merge commit has been made between the basisbranch and {- A merge commit has been made between the basisbranch and

View file

@ -76,8 +76,9 @@ watchChangedRefs = do
chan <- liftIO $ newTBMChanIO 100 chan <- liftIO $ newTBMChanIO 100
g <- gitRepo g <- gitRepo
let refdir = fromRawFilePath (Git.localGitDir g) </> "refs" let gittop = fromRawFilePath (Git.localGitDir g)
liftIO $ createDirectoryIfMissing True refdir let refdir = gittop </> "refs"
liftIO $ createDirectoryUnder gittop refdir
let notifyhook = Just $ notifyHook chan let notifyhook = Just $ notifyHook chan
let hooks = mkWatchHooks let hooks = mkWatchHooks

View file

@ -879,8 +879,7 @@ withTmpWorkDir key action = do
liftIO $ writeFile obj "" liftIO $ writeFile obj ""
setAnnexFilePerm obj setAnnexFilePerm obj
let tmpdir = gitAnnexTmpWorkDir obj let tmpdir = gitAnnexTmpWorkDir obj
liftIO $ createDirectoryIfMissing True tmpdir createAnnexDirectory tmpdir
setAnnexDirPerm tmpdir
res <- action tmpdir res <- action tmpdir
case res of case res of
Just _ -> liftIO $ removeDirectoryRecursive tmpdir Just _ -> liftIO $ removeDirectoryRecursive tmpdir

View file

@ -75,6 +75,7 @@ startDaemon assistant foreground startdelay cannotrun listenhost startbrowser =
pidfile <- fromRepo gitAnnexPidFile pidfile <- fromRepo gitAnnexPidFile
logfile <- fromRepo gitAnnexLogFile logfile <- fromRepo gitAnnexLogFile
liftIO $ debugM desc $ "logging to " ++ logfile liftIO $ debugM desc $ "logging to " ++ logfile
createAnnexDirectory (parentDir pidfile)
#ifndef mingw32_HOST_OS #ifndef mingw32_HOST_OS
createAnnexDirectory (parentDir logfile) createAnnexDirectory (parentDir logfile)
logfd <- liftIO $ handleToFd =<< openLog logfile logfd <- liftIO $ handleToFd =<< openLog logfile

View file

@ -33,8 +33,9 @@ configureSmudgeFilter = unlessM (fromRepo Git.repoIsLocalBare) $ do
gf <- Annex.fromRepo Git.attributes gf <- Annex.fromRepo Git.attributes
lfs <- readattr lf lfs <- readattr lf
gfs <- readattr gf gfs <- readattr gf
gittop <- fromRawFilePath . Git.localGitDir <$> gitRepo
liftIO $ unless ("filter=annex" `isInfixOf` (lfs ++ gfs)) $ do liftIO $ unless ("filter=annex" `isInfixOf` (lfs ++ gfs)) $ do
createDirectoryIfMissing True (takeDirectory lf) createDirectoryUnder gittop (takeDirectory lf)
writeFile lf (lfs ++ "\n" ++ unlines stdattr) writeFile lf (lfs ++ "\n" ++ unlines stdattr)
where where
readattr = liftIO . catchDefaultIO "" . readFileStrict readattr = liftIO . catchDefaultIO "" . readFileStrict

View file

@ -1,6 +1,6 @@
{- Persistent sqlite database initialization {- Persistent sqlite database initialization
- -
- Copyright 2015-2018 Joey Hess <id@joeyh.name> - Copyright 2015-2020 Joey Hess <id@joeyh.name>
- -
- Licensed under the GNU AGPL version 3 or higher. - Licensed under the GNU AGPL version 3 or higher.
-} -}
@ -10,6 +10,7 @@ module Database.Init where
import Annex.Common import Annex.Common
import Annex.Perms import Annex.Perms
import Utility.FileMode import Utility.FileMode
import Utility.Directory
import Database.Persist.Sqlite import Database.Persist.Sqlite
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
@ -29,9 +30,10 @@ initDb db migration = do
let dbdir = takeDirectory db let dbdir = takeDirectory db
let tmpdbdir = dbdir ++ ".tmp" let tmpdbdir = dbdir ++ ".tmp"
let tmpdb = tmpdbdir </> "db" let tmpdb = tmpdbdir </> "db"
let tdb = T.pack tmpdb let tdb = T.pack tmpdb
top <- parentDir . fromRawFilePath <$> fromRepo gitAnnexDir
liftIO $ do liftIO $ do
createDirectoryIfMissing True tmpdbdir createDirectoryUnder top tmpdbdir
runSqliteInfo (enableWAL tdb) migration runSqliteInfo (enableWAL tdb) migration
setAnnexDirPerm tmpdbdir setAnnexDirPerm tmpdbdir
-- Work around sqlite bug that prevents it from honoring -- Work around sqlite bug that prevents it from honoring

View file

@ -170,13 +170,13 @@ checkDiskSpaceDirectory d k = do
store :: FilePath -> ChunkConfig -> Key -> L.ByteString -> MeterUpdate -> Annex Bool store :: FilePath -> ChunkConfig -> Key -> L.ByteString -> MeterUpdate -> Annex Bool
store d chunkconfig k b p = liftIO $ do store d chunkconfig k b p = liftIO $ do
void $ tryIO $ createDirectoryIfMissing True tmpdir void $ tryIO $ createDirectoryUnder d tmpdir
case chunkconfig of 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 _ -> do
let tmpf = tmpdir </> kf let tmpf = tmpdir </> kf
meteredWriteFile p tmpf b meteredWriteFile p tmpf b
finalizeStoreGeneric tmpdir destdir finalizeStoreGeneric d tmpdir destdir
return True return True
where where
tmpdir = addTrailingPathSeparator $ d </> "tmp" </> kf 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, moves it into place. Anything already existing
- in the dest directory will be deleted. File permissions will be locked - in the dest directory will be deleted. File permissions will be locked
- down. -} - down. -}
finalizeStoreGeneric :: FilePath -> FilePath -> IO () finalizeStoreGeneric :: FilePath -> FilePath -> FilePath -> IO ()
finalizeStoreGeneric tmp dest = do finalizeStoreGeneric d tmp dest = do
void $ tryIO $ allowWrite dest -- may already exist void $ tryIO $ allowWrite dest -- may already exist
void $ tryIO $ removeDirectoryRecursive dest -- or not exist void $ tryIO $ removeDirectoryRecursive dest -- or not exist
createDirectoryIfMissing True (parentDir dest) createDirectoryUnder d (parentDir dest)
renameDirectory tmp dest renameDirectory tmp dest
-- may fail on some filesystems -- may fail on some filesystems
void $ tryIO $ do void $ tryIO $ do
@ -267,7 +267,7 @@ checkPresentGeneric' d check = ifM check
storeExportM :: FilePath -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex Bool storeExportM :: FilePath -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex Bool
storeExportM d src _k loc p = liftIO $ catchBoolIO $ do 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 -- Write via temp file so that checkPresentGeneric will not
-- see it until it's fully stored. -- see it until it's fully stored.
viaTmp (\tmp () -> withMeteredFile src p (L.writeFile tmp)) dest () 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 renameExportM d _k oldloc newloc = liftIO $ Just <$> go
where where
go = catchBoolIO $ do go = catchBoolIO $ do
createDirectoryIfMissing True (takeDirectory dest) createDirectoryUnder d (takeDirectory dest)
renameFile src dest renameFile src dest
removeExportLocation d oldloc removeExportLocation d oldloc
return True return True
@ -413,7 +413,7 @@ storeExportWithContentIdentifierM dir src _k loc overwritablecids p =
catchIO go (return . Left . show) catchIO go (return . Left . show)
where where
go = do go = do
liftIO $ createDirectoryIfMissing True destdir liftIO $ createDirectoryUnder dir destdir
withTmpFileIn destdir template $ \tmpf tmph -> do withTmpFileIn destdir template $ \tmpf tmph -> do
liftIO $ withMeteredFile src p (L.hPut tmph) liftIO $ withMeteredFile src p (L.hPut tmph)
liftIO $ hFlush tmph liftIO $ hFlush tmph

View file

@ -70,9 +70,9 @@ storeLegacyChunked' meterupdate chunksize (d:dests) bs c = do
feed bytes' (sz - s) ls h feed bytes' (sz - s) ls h
else return (l:ls) else return (l:ls)
storeHelper :: (FilePath -> FilePath -> IO ()) -> Key -> ([FilePath] -> IO [FilePath]) -> FilePath -> FilePath -> IO Bool storeHelper :: FilePath -> (FilePath -> FilePath -> IO ()) -> Key -> ([FilePath] -> IO [FilePath]) -> FilePath -> FilePath -> IO Bool
storeHelper finalizer key storer tmpdir destdir = do storeHelper repotop finalizer key storer tmpdir destdir = do
void $ liftIO $ tryIO $ createDirectoryIfMissing True tmpdir void $ liftIO $ tryIO $ createDirectoryUnder repotop tmpdir
Legacy.storeChunks key tmpdir destdir storer recorder finalizer Legacy.storeChunks key tmpdir destdir storer recorder finalizer
where where
recorder f s = do recorder f s = do
@ -80,8 +80,8 @@ storeHelper finalizer key storer tmpdir destdir = do
writeFile f s writeFile f s
void $ tryIO $ preventWrite f void $ tryIO $ preventWrite f
store :: ChunkSize -> (FilePath -> FilePath -> IO ()) -> Key -> L.ByteString -> MeterUpdate -> FilePath -> FilePath -> IO Bool store :: FilePath -> ChunkSize -> (FilePath -> FilePath -> IO ()) -> Key -> L.ByteString -> MeterUpdate -> FilePath -> FilePath -> IO Bool
store chunksize finalizer k b p = storeHelper finalizer k $ \dests -> store repotop chunksize finalizer k b p = storeHelper repotop finalizer k $ \dests ->
storeLegacyChunked p chunksize dests b storeLegacyChunked p chunksize dests b
{- Need to get a single ByteString containing every chunk. {- Need to get a single ByteString containing every chunk.

View file

@ -372,7 +372,7 @@ store' repo r rsyncopts
let tmpf = tmpdir </> fromRawFilePath (keyFile k) let tmpf = tmpdir </> fromRawFilePath (keyFile k)
meteredWriteFile p tmpf b meteredWriteFile p tmpf b
let destdir = parentDir $ gCryptLocation repo k let destdir = parentDir $ gCryptLocation repo k
Remote.Directory.finalizeStoreGeneric tmpdir destdir Remote.Directory.finalizeStoreGeneric (Git.repoLocation repo) tmpdir destdir
return True return True
| Git.repoIsSsh repo = if accessShell r | Git.repoIsSsh repo = if accessShell r
then fileStorer $ \k f p -> do then fileStorer $ \k f p -> do

View file

@ -48,7 +48,7 @@ runHooks r starthook stophook a = do
dir <- fromRepo gitAnnexRemotesDir dir <- fromRepo gitAnnexRemotesDir
let lck = dir </> remoteid ++ ".lck" let lck = dir </> remoteid ++ ".lck"
whenM (notElem lck . M.keys <$> getLockCache) $ do whenM (notElem lck . M.keys <$> getLockCache) $ do
liftIO $ createDirectoryIfMissing True dir createAnnexDirectory dir
firstrun lck firstrun lck
a a
where where

View file

@ -90,7 +90,6 @@ foreground pidfile a = do
- Fails if the pid file is already locked by another process. -} - Fails if the pid file is already locked by another process. -}
lockPidFile :: FilePath -> IO () lockPidFile :: FilePath -> IO ()
lockPidFile pidfile = do lockPidFile pidfile = do
createDirectoryIfMissing True (parentDir pidfile)
#ifndef mingw32_HOST_OS #ifndef mingw32_HOST_OS
fd <- openFd pidfile ReadWrite (Just stdFileMode) defaultFileFlags fd <- openFd pidfile ReadWrite (Just stdFileMode) defaultFileFlags
locked <- catchMaybeIO $ setLock fd (WriteLock, AbsoluteSeek, 0, 0) locked <- catchMaybeIO $ setLock fd (WriteLock, AbsoluteSeek, 0, 0)

View file

@ -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.
"""]]