use RawFilePath version of rename

Some small wins, almost certianly swamped by the system calls, but still
worthwhile progress on the RawFilePath conversion.

Sponsored-by: Erik Bjäreholt on Patreon
This commit is contained in:
Joey Hess 2022-06-22 16:47:34 -04:00
parent d00e23cac9
commit debcf86029
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
16 changed files with 58 additions and 54 deletions

View file

@ -82,15 +82,14 @@ mergeToAdjustedBranch tomerge (origbranch, adj) mergeconfig canresolvemerge comm
refs <- liftIO $ dirContentsRecursive $
git_dir' </> "refs"
let refs' = (git_dir' </> "packed-refs") : refs
liftIO $ forM_ refs' $ \src ->
liftIO $ forM_ refs' $ \src -> do
let src' = toRawFilePath src
whenM (doesFileExist src) $ do
dest <- relPathDirToFile git_dir
(toRawFilePath src)
dest <- relPathDirToFile git_dir src'
let dest' = toRawFilePath tmpgit P.</> dest
createDirectoryUnder git_dir
(P.takeDirectory dest')
void $ createLinkOrCopy src
(fromRawFilePath dest')
void $ createLinkOrCopy src' dest'
-- This reset makes git merge not care
-- that the work tree is empty; otherwise
-- it will think that all the files have

View file

@ -410,9 +410,7 @@ moveAnnex key af src = ifM (checkSecureHashes' key)
storeobject dest = ifM (liftIO $ R.doesPathExist dest)
( alreadyhave
, adjustedBranchRefresh af $ modifyContentDir dest $ do
liftIO $ moveFile
(fromRawFilePath src)
(fromRawFilePath dest)
liftIO $ moveFile src dest
-- Freeze the object file now that it is in place.
-- Waiting until now to freeze it allows for freeze
-- hooks that prevent moving the file.
@ -654,17 +652,16 @@ removeAnnex (ContentRemovalLock key) = withObjectLoc key $ \file ->
{- Moves a key out of .git/annex/objects/ into .git/annex/bad, and
- returns the file it was moved to. -}
moveBad :: Key -> Annex FilePath
moveBad :: Key -> Annex RawFilePath
moveBad key = do
src <- calcRepo (gitAnnexLocation key)
bad <- fromRepo gitAnnexBadDir
let dest = bad P.</> P.takeFileName src
let dest' = fromRawFilePath dest
createAnnexDirectory (parentDir dest)
cleanObjectLoc key $
liftIO $ moveFile (fromRawFilePath src) dest'
liftIO $ moveFile src dest
logStatus key InfoMissing
return dest'
return dest
data KeyLocation = InAnnex | InAnywhere

View file

@ -84,10 +84,11 @@ setJournalFile _jl ru file content = withOtherTmp $ \tmp -> do
createAnnexDirectory jd
-- journal file is written atomically
let jfile = journalFile file
let tmpfile = fromRawFilePath (tmp P.</> jfile)
let tmpfile = tmp P.</> jfile
liftIO $ do
withFile tmpfile WriteMode $ \h -> writeJournalHandle h content
moveFile tmpfile (fromRawFilePath (jd P.</> jfile))
withFile (fromRawFilePath tmpfile) WriteMode $ \h ->
writeJournalHandle h content
moveFile tmpfile (jd P.</> jfile)
data JournalledContent
= NoJournalledContent

View file

@ -218,10 +218,10 @@ restagePointerFile (Restage True) f orig = withTSDelta $ \tsd ->
showwarning = warning $ unableToRestage Nothing
go Nothing = showwarning
go (Just _) = withTmpDirIn (fromRawFilePath $ Git.localGitDir r) "annexindex" $ \tmpdir -> do
let tmpindex = tmpdir </> "index"
let tmpindex = toRawFilePath (tmpdir </> "index")
let updatetmpindex = do
r' <- liftIO $ Git.Env.addGitEnv r Git.Index.indexEnv
=<< Git.Index.indexEnvVal (toRawFilePath tmpindex)
=<< Git.Index.indexEnvVal tmpindex
-- Avoid git warning about CRLF munging.
let r'' = r' { gitGlobalOpts = gitGlobalOpts r' ++
[ Param "-c"
@ -233,9 +233,9 @@ restagePointerFile (Restage True) f orig = withTSDelta $ \tsd ->
whenM checkunmodified $
feed f'
let replaceindex = catchBoolIO $ do
moveFile tmpindex (fromRawFilePath realindex)
moveFile tmpindex realindex
return True
ok <- liftIO (createLinkOrCopy (fromRawFilePath realindex) tmpindex)
ok <- liftIO (createLinkOrCopy realindex tmpindex)
<&&> updatetmpindex
<&&> liftIO replaceindex
unless ok showwarning

View file

@ -75,13 +75,13 @@ replaceFile' createdirectory file checkres action = withOtherTmp $ \othertmpdir
let tmpfile = tmpdir </> basetmp
r <- action tmpfile
when (checkres r) $
replaceFileFrom tmpfile file createdirectory
replaceFileFrom (toRawFilePath tmpfile) (toRawFilePath file) createdirectory
return r
replaceFileFrom :: FilePath -> FilePath -> (RawFilePath -> Annex ()) -> Annex ()
replaceFileFrom :: RawFilePath -> RawFilePath -> (RawFilePath -> Annex ()) -> Annex ()
replaceFileFrom src dest createdirectory = go `catchIO` fallback
where
go = liftIO $ moveFile src dest
fallback _ = do
createdirectory (parentDir (toRawFilePath dest))
createdirectory (parentDir dest)
go

View file

@ -28,6 +28,7 @@ import Utility.InodeCache
import Annex.InodeSentinal
import Annex.CheckIgnore
import qualified Utility.RawFilePath as R
import qualified System.FilePath.ByteString as P
import System.PosixCompat.Files
@ -208,15 +209,15 @@ start si file addunlockedmatcher =
starting "add" (ActionItemTreeFile file) si $
addingExistingLink file key $
withOtherTmp $ \tmp -> do
let tmpf = fromRawFilePath tmp </> fromRawFilePath file
liftIO $ moveFile (fromRawFilePath file) tmpf
ifM (isSymbolicLink <$> liftIO (getSymbolicLinkStatus tmpf))
let tmpf = tmp P.</> file
liftIO $ moveFile file tmpf
ifM (isSymbolicLink <$> liftIO (R.getSymbolicLinkStatus tmpf))
( do
liftIO $ removeFile tmpf
liftIO $ R.removeLink tmpf
addSymlink file key Nothing
next $ cleanup key =<< inAnnex key
, do
liftIO $ moveFile tmpf (fromRawFilePath file)
liftIO $ moveFile tmpf file
next $ return True
)
fixuppointer s key =

View file

@ -613,7 +613,7 @@ honorDead dead
badContent :: Key -> Annex String
badContent key = do
dest <- moveBad key
return $ "moved to " ++ dest
return $ "moved to " ++ fromRawFilePath dest
{- Bad content is dropped from the remote. We have downloaded a copy
- from the remote to a temp file already (in some cases, it's just a
@ -633,7 +633,7 @@ badContentRemote remote localcopy key = do
ifM (isSymbolicLink <$> R.getSymbolicLinkStatus localcopy)
( copyFileExternal CopyTimeStamps (fromRawFilePath localcopy) destbad'
, do
moveFile (fromRawFilePath localcopy) destbad'
moveFile localcopy destbad
return True
)
)

View file

@ -207,12 +207,8 @@ startLocal o addunlockedmatcher largematcher mode (srcfile, destfile) =
(fromRawFilePath destfile)
return $ removeWhenExistsWith R.removeLink destfile
else do
moveFile
(fromRawFilePath srcfile)
(fromRawFilePath destfile)
return $ moveFile
(fromRawFilePath destfile)
(fromRawFilePath srcfile)
moveFile srcfile destfile
return $ moveFile destfile srcfile
-- Make sure that the dest file has its write permissions
-- removed; the src file normally already did, but may
-- have imported it from a filesystem that does not allow

View file

@ -38,7 +38,7 @@ perform file key = do
ok <- getViaTmp RetrievalAllKeysSecure DefaultVerify key (AssociatedFile Nothing) $ \dest -> unVerified $
if dest /= file
then liftIO $ catchBoolIO $ do
moveFile (fromRawFilePath file) (fromRawFilePath dest)
moveFile file dest
return True
else return True
if ok

View file

@ -95,7 +95,7 @@ explodePacks r = go =<< listPackFiles r
let dest = objectsDir r P.</> f
createDirectoryIfMissing True
(fromRawFilePath (parentDir dest))
moveFile objfile (fromRawFilePath dest)
moveFile (toRawFilePath objfile) dest
forM_ packs $ \packfile -> do
let f = toRawFilePath packfile
removeWhenExistsWith R.removeLink f

View file

@ -407,7 +407,7 @@ retrieveExportWithContentIdentifierM borgrepo loc _ dest gk _ = do
forceSuccessProcess p pid
-- Filepaths in borg archives are relative, so it's ok to
-- combine with </>
moveFile (fromRawFilePath othertmp </> fromRawFilePath archivefile) dest
moveFile (othertmp P.</> archivefile) (toRawFilePath dest)
removeDirectoryRecursive (fromRawFilePath othertmp)
(archivename, archivefile) = extractImportLocation loc

View file

@ -403,7 +403,7 @@ writeRetrievedContent
writeRetrievedContent dest enc encc mh mp content miv = case (enc, mh, content) of
(Nothing, Nothing, FileContent f)
| f == dest -> noop
| otherwise -> liftIO $ moveFile f dest
| otherwise -> liftIO $ moveFile (toRawFilePath f) (toRawFilePath dest)
(Just (cipher, _), _, ByteContent b) -> do
cmd <- gpgCmd <$> Annex.getGitConfig
decrypt cmd encc cipher (feedBytes b) $

View file

@ -226,7 +226,7 @@ store o k src meterupdate = storeGeneric o meterupdate basedest populatedest
then do
rename src dest
return True
else createLinkOrCopy src dest
else createLinkOrCopy (toRawFilePath src) (toRawFilePath dest)
{- If the key being sent is encrypted or chunked, the file
- containing its content is a temp file, and so can be
- renamed into place. Otherwise, the file is the annexed
@ -315,7 +315,7 @@ storeExportM o src _k loc meterupdate =
storeGeneric o meterupdate basedest populatedest
where
basedest = fromRawFilePath (fromExportLocation loc)
populatedest = liftIO . createLinkOrCopy src
populatedest = liftIO . createLinkOrCopy (toRawFilePath src) . toRawFilePath
retrieveExportM :: RsyncOpts -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Verification
retrieveExportM o k loc dest p =

View file

@ -14,6 +14,7 @@ module Utility.CopyFile (
import Common
import qualified BuildInfo
import qualified Utility.RawFilePath as R
data CopyMetaData
-- Copy timestamps when possible, but no other metadata, and
@ -86,10 +87,10 @@ copyCoW meta src dest
{- Create a hard link if the filesystem allows it, and fall back to copying
- the file. -}
createLinkOrCopy :: FilePath -> FilePath -> IO Bool
createLinkOrCopy :: RawFilePath -> RawFilePath -> IO Bool
createLinkOrCopy src dest = go `catchIO` const fallback
where
go = do
createLink src dest
R.createLink src dest
return True
fallback = copyFileExternal CopyAllMetaData src dest
fallback = copyFileExternal CopyAllMetaData (fromRawFilePath src) (fromRawFilePath dest)

View file

@ -14,8 +14,7 @@ module Utility.MoveFile (
) where
import Control.Monad
import System.FilePath
import System.PosixCompat.Files hiding (removeLink)
import System.PosixCompat.Files (isDirectory)
import System.IO.Error
import Prelude
@ -28,17 +27,19 @@ import Utility.SystemDirectory
import Utility.Tmp
import Utility.Exception
import Utility.Monad
import Utility.FileSystemEncoding
import qualified Utility.RawFilePath as R
{- Moves one filename to another.
- First tries a rename, but falls back to moving across devices if needed. -}
moveFile :: FilePath -> FilePath -> IO ()
moveFile src dest = tryIO (rename src dest) >>= onrename
moveFile :: RawFilePath -> RawFilePath -> IO ()
moveFile src dest = tryIO (R.rename src dest) >>= onrename
where
onrename (Right _) = noop
onrename (Left e)
| isPermissionError e = rethrow
| isDoesNotExistError e = rethrow
| otherwise = viaTmp mv dest ()
| otherwise = viaTmp mv (fromRawFilePath dest) ()
where
rethrow = throwM e
@ -46,16 +47,20 @@ moveFile src dest = tryIO (rename src dest) >>= onrename
-- copyFile is likely not as optimised as
-- the mv command, so we'll use the command.
--
-- But, while Windows has a "mv", it does not seem very
-- reliable, so use copyFile there.
-- But, while Windows has a "mv", it does not
-- seem very reliable, so use copyFile there.
#ifndef mingw32_HOST_OS
-- If dest is a directory, mv would move the file
-- into it, which is not desired.
whenM (isdir dest) rethrow
ok <- boolSystem "mv" [Param "-f", Param src, Param tmp]
ok <- boolSystem "mv"
[ Param "-f"
, Param (fromRawFilePath src)
, Param tmp
]
let e' = e
#else
r <- tryIO $ copyFile src tmp
r <- tryIO $ copyFile (fromRawFilePath src) tmp
let (ok, e') = case r of
Left err -> (False, err)
Right _ -> (True, e)
@ -67,7 +72,7 @@ moveFile src dest = tryIO (rename src dest) >>= onrename
#ifndef mingw32_HOST_OS
isdir f = do
r <- tryIO $ getFileStatus f
r <- tryIO $ R.getFileStatus f
case r of
(Left _) -> return False
(Right s) -> return $ isDirectory s

View file

@ -27,6 +27,7 @@ module Utility.RawFilePath (
getCurrentDirectory,
createDirectory,
setFileMode,
rename,
) where
#ifndef mingw32_HOST_OS
@ -87,4 +88,7 @@ createDirectory = D.createDirectory . fromRawFilePath
setFileMode :: RawFilePath -> FileMode -> IO ()
setFileMode = F.setFileMode . fromRawFilePath
rename :: RawFilePath -> RawFilePath -> IO ()
rename a b = F.rename (fromRawFilePath a) (fromRawFilePath b)
#endif