From 25e4f84e8fbf68b493b8df99f7c13532e1b04ee7 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 12 Feb 2025 13:11:27 -0400 Subject: [PATCH] push down OsPath into CopyFile --- Annex/CopyFile.hs | 33 +++++++++++++++------------------ Remote/Directory.hs | 16 ++++++++-------- Remote/Git.hs | 2 +- Utility/CopyFile.hs | 6 +++--- 4 files changed, 27 insertions(+), 30 deletions(-) diff --git a/Annex/CopyFile.hs b/Annex/CopyFile.hs index 76bf5d25e9..133ed4f8d7 100644 --- a/Annex/CopyFile.hs +++ b/Annex/CopyFile.hs @@ -15,6 +15,7 @@ import Utility.CopyFile import Utility.FileMode import Utility.Touch import Utility.Hash (IncrementalVerifier(..)) +import qualified Utility.FileIO as F import qualified Utility.RawFilePath as R import Control.Concurrent @@ -34,7 +35,7 @@ newCopyCoWTried = CopyCoWTried <$> newEmptyMVar - The destination file must not exist yet (or may exist but be empty), - or it will fail to make a CoW copy, and will return false. -} -tryCopyCoW :: CopyCoWTried -> FilePath -> FilePath -> MeterUpdate -> IO Bool +tryCopyCoW :: CopyCoWTried -> OsPath -> OsPath -> MeterUpdate -> IO Bool tryCopyCoW (CopyCoWTried copycowtried) src dest meterupdate = -- If multiple threads reach this at the same time, they -- will both try CoW, which is acceptable. @@ -51,27 +52,25 @@ tryCopyCoW (CopyCoWTried copycowtried) src dest meterupdate = -- CoW is known to work, so delete -- dest if it exists in order to do a fast -- CoW copy. - void $ tryIO $ removeFile dest' + void $ tryIO $ removeFile dest docopycow , return False ) ) where - docopycow = watchFileSize dest' meterupdate $ const $ + docopycow = watchFileSize dest meterupdate $ const $ copyCoW CopyTimeStamps src dest - - dest' = toOsPath dest -- Check if the dest file already exists, which would prevent -- probing CoW. If the file exists but is empty, there's no benefit -- to resuming from it when CoW does not work, so remove it. destfilealreadypopulated = - tryIO (R.getFileStatus (toRawFilePath dest)) >>= \case + tryIO (R.getFileStatus (fromOsPath dest)) >>= \case Left _ -> return False Right st -> do - sz <- getFileSize' dest' st + sz <- getFileSize' dest st if sz == 0 - then tryIO (removeFile dest') >>= \case + then tryIO (removeFile dest) >>= \case Right () -> return False Left _ -> return True else return True @@ -95,7 +94,7 @@ data CopyMethod = CopiedCoW | Copied - (eg when isStableKey is false), and doing this avoids getting a - corrupted file in such cases. -} -fileCopier :: CopyCoWTried -> FilePath -> FilePath -> MeterUpdate -> Maybe IncrementalVerifier -> IO CopyMethod +fileCopier :: CopyCoWTried -> OsPath -> OsPath -> MeterUpdate -> Maybe IncrementalVerifier -> IO CopyMethod #ifdef mingw32_HOST_OS fileCopier _ src dest meterupdate iv = docopy #else @@ -111,28 +110,26 @@ fileCopier copycowtried src dest meterupdate iv = docopy = do -- The file might have had the write bit removed, -- so make sure we can write to it. - void $ tryIO $ allowWrite (toOsPath dest) + void $ tryIO $ allowWrite dest - withBinaryFile src ReadMode $ \hsrc -> + F.withBinaryFile src ReadMode $ \hsrc -> fileContentCopier hsrc dest meterupdate iv -- Copy src mode and mtime. - mode <- fileMode <$> R.getFileStatus (toRawFilePath src) - mtime <- utcTimeToPOSIXSeconds - <$> getModificationTime (toOsPath src) + mode <- fileMode <$> R.getFileStatus (fromOsPath src) + mtime <- utcTimeToPOSIXSeconds <$> getModificationTime src + let dest' = fromOsPath dest R.setFileMode dest' mode touch dest' mtime False return Copied - - dest' = toRawFilePath dest {- Copies content from a handle to a destination file. Does not - use copy-on-write, and does not copy file mode and mtime. -} -fileContentCopier :: Handle -> FilePath -> MeterUpdate -> Maybe IncrementalVerifier -> IO () +fileContentCopier :: Handle -> OsPath -> MeterUpdate -> Maybe IncrementalVerifier -> IO () fileContentCopier hsrc dest meterupdate iv = - withBinaryFile dest ReadWriteMode $ \hdest -> do + F.withBinaryFile dest ReadWriteMode $ \hdest -> do sofar <- compareexisting hdest zeroBytesProcessed docopy hdest sofar where diff --git a/Remote/Directory.hs b/Remote/Directory.hs index 75e003d5a1..372a485ba7 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -210,7 +210,7 @@ storeKeyM d chunkconfig cow k c m = in byteStorer go k c m NoChunks -> let go _k src p = liftIO $ do - void $ fileCopier cow (fromOsPath src) (fromOsPath tmpf) p Nothing + void $ fileCopier cow src tmpf p Nothing finalizeStoreGeneric d tmpdir destdir in fileStorer go k c m _ -> @@ -251,7 +251,7 @@ retrieveKeyFileM :: OsPath -> ChunkConfig -> CopyCoWTried -> Retriever retrieveKeyFileM d (LegacyChunks _) _ = Legacy.retrieve locations' d retrieveKeyFileM d NoChunks cow = fileRetriever' $ \dest k p iv -> do src <- liftIO $ getLocation d k - void $ liftIO $ fileCopier cow (fromOsPath src) (fromOsPath dest) p iv + void $ liftIO $ fileCopier cow src dest p iv retrieveKeyFileM d _ _ = byteRetriever $ \k sink -> sink =<< liftIO (F.readFile =<< getLocation d k) @@ -336,14 +336,14 @@ storeExportM d cow src _k loc p = do where dest = exportPath d loc go tmp () = void $ liftIO $ - fileCopier cow (fromOsPath src) (fromOsPath tmp) p Nothing + fileCopier cow src tmp p Nothing retrieveExportM :: OsPath -> CopyCoWTried -> Key -> ExportLocation -> OsPath -> MeterUpdate -> Annex Verification retrieveExportM d cow k loc dest p = verifyKeyContentIncrementally AlwaysVerify k $ \iv -> - void $ liftIO $ fileCopier cow src (fromOsPath dest) p iv + void $ liftIO $ fileCopier cow src dest p iv where - src = fromOsPath $ exportPath d loc + src = exportPath d loc removeExportM :: OsPath -> Key -> ExportLocation -> Annex () removeExportM d _k loc = liftIO $ do @@ -462,7 +462,7 @@ retrieveExportWithContentIdentifierM ii dir cow loc cids dest gk p = go iv = precheck (docopy iv) - docopy iv = ifM (liftIO $ tryCopyCoW cow (fromOsPath f) (fromOsPath dest) p) + docopy iv = ifM (liftIO $ tryCopyCoW cow f dest p) ( postcheckcow (liftIO $ maybe noop unableIncrementalVerifier iv) , docopynoncow iv ) @@ -484,7 +484,7 @@ retrieveExportWithContentIdentifierM ii dir cow loc cids dest gk p = let close = hClose bracketIO open close $ \h -> do #endif - liftIO $ fileContentCopier h (fromOsPath dest) p iv + liftIO $ fileContentCopier h dest p iv #ifndef mingw32_HOST_OS postchecknoncow dupfd (return ()) #else @@ -539,7 +539,7 @@ storeExportWithContentIdentifierM ii dir cow src _k loc overwritablecids p = do withTmpFileIn destdir template $ \tmpf tmph -> do let tmpf' = fromOsPath tmpf liftIO $ hClose tmph - void $ liftIO $ fileCopier cow (fromOsPath src) (fromOsPath tmpf) p Nothing + void $ liftIO $ fileCopier cow src tmpf p Nothing resetAnnexFilePerm tmpf liftIO (R.getSymbolicLinkStatus tmpf') >>= liftIO . mkContentIdentifier ii tmpf >>= \case Nothing -> giveup "unable to generate content identifier" diff --git a/Remote/Git.hs b/Remote/Git.hs index 15e99be129..71c6571554 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -848,7 +848,7 @@ mkFileCopier remotewanthardlink (State _ _ copycowtried _ _) = do where copier src dest k p check verifyconfig = do iv <- startVerifyKeyContentIncrementally verifyconfig k - liftIO (fileCopier copycowtried (fromOsPath src) (fromOsPath dest) p iv) >>= \case + liftIO (fileCopier copycowtried src dest p iv) >>= \case Copied -> ifM check ( finishVerifyKeyContentIncrementally iv , do diff --git a/Utility/CopyFile.hs b/Utility/CopyFile.hs index d0dc34eef2..2a838ff735 100644 --- a/Utility/CopyFile.hs +++ b/Utility/CopyFile.hs @@ -62,13 +62,13 @@ copyFileExternal meta src dest = do - The dest file must not exist yet, or it will fail to make a CoW copy, - and will return False. -} -copyCoW :: CopyMetaData -> FilePath -> FilePath -> IO Bool +copyCoW :: CopyMetaData -> OsPath -> OsPath -> IO Bool copyCoW meta src dest | BuildInfo.cp_reflink_supported = do -- When CoW is not supported, cp will complain to stderr, -- so have to discard its stderr. ok <- catchBoolIO $ withNullHandle $ \nullh -> - let p = (proc "cp" $ toCommand $ params ++ [File src, File dest]) + let p = (proc "cp" $ toCommand $ params ++ [File (fromOsPath src), File (fromOsPath dest)]) { std_out = UseHandle nullh , std_err = UseHandle nullh } @@ -76,7 +76,7 @@ copyCoW meta src dest -- When CoW is not supported, cp creates the destination -- file but leaves it empty. unless ok $ - void $ tryIO $ removeFile $ toOsPath dest + void $ tryIO $ removeFile dest return ok | otherwise = return False where