some easy createDirectoryUnder conversions
This commit is contained in:
parent
ebbc5004fa
commit
6d58ca94d6
12 changed files with 44 additions and 30 deletions
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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.
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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.
|
||||||
|
"""]]
|
Loading…
Add table
Reference in a new issue