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