21ff5e1e5a
Improved probing when CoW copies can be made between files on the same drive. Now supports CoW between BTRFS subvolumes. And, falls back to rsync instead of using cp when CoW won't work, eg copies between repos on the same EXT4 filesystem. Rather than trying cp --reflink=always for each file copied to a remote, it's tried once and if it fails it falls back to using rsync thereafter for the lifetime of the Remote object. That avoids overhead of calling cp which while small, will add up over a large number of files. This commit was sponsored by Boyd Stephen Smith Jr. on Patreon.
81 lines
2.3 KiB
Haskell
81 lines
2.3 KiB
Haskell
{- file copying
|
|
-
|
|
- Copyright 2010-2019 Joey Hess <id@joeyh.name>
|
|
-
|
|
- License: BSD-2-clause
|
|
-}
|
|
|
|
module Utility.CopyFile (
|
|
copyFileExternal,
|
|
copyCoW,
|
|
createLinkOrCopy,
|
|
CopyMetaData(..)
|
|
) where
|
|
|
|
import Common
|
|
import qualified BuildInfo
|
|
|
|
data CopyMetaData
|
|
-- Copy timestamps when possible, but no other metadata, and
|
|
-- when copying a symlink, makes a copy of its content.
|
|
= CopyTimeStamps
|
|
-- Copy all metadata when possible.
|
|
| CopyAllMetaData
|
|
deriving (Eq)
|
|
|
|
copyMetaDataParams :: CopyMetaData -> [CommandParam]
|
|
copyMetaDataParams meta = map snd $ filter fst
|
|
[ (allmeta && BuildInfo.cp_a, Param "-a")
|
|
, (allmeta && BuildInfo.cp_p && not BuildInfo.cp_a
|
|
, Param "-p")
|
|
, (not allmeta && BuildInfo.cp_preserve_timestamps
|
|
, Param "--preserve=timestamps")
|
|
]
|
|
where
|
|
allmeta = meta == CopyAllMetaData
|
|
|
|
{- The cp command is used, because I hate reinventing the wheel,
|
|
- and because this allows easy access to features like cp --reflink. -}
|
|
copyFileExternal :: CopyMetaData -> FilePath -> FilePath -> IO Bool
|
|
copyFileExternal meta src dest = do
|
|
whenM (doesFileExist dest) $
|
|
removeFile dest
|
|
boolSystem "cp" $ params ++ [File src, File dest]
|
|
where
|
|
params
|
|
| BuildInfo.cp_reflink_supported =
|
|
Param "--reflink=auto" : copyMetaDataParams meta
|
|
| otherwise = copyMetaDataParams meta
|
|
|
|
{- When a filesystem supports CoW (and cp does), uses it to make
|
|
- an efficient copy of a file. Otherwise, returns False. -}
|
|
copyCoW :: CopyMetaData -> FilePath -> FilePath -> IO Bool
|
|
copyCoW meta src dest
|
|
| BuildInfo.cp_reflink_supported = do
|
|
whenM (doesFileExist dest) $
|
|
removeFile dest
|
|
-- When CoW is not supported, cp will complain to stderr,
|
|
-- so have to discard its stderr.
|
|
ok <- catchBoolIO $ do
|
|
withQuietOutput createProcessSuccess $
|
|
proc "cp" $ toCommand $
|
|
params ++ [File src, File dest]
|
|
return True
|
|
-- When CoW is not supported, cp creates the destination
|
|
-- file but leaves it empty.
|
|
unless ok $
|
|
void $ tryIO $ removeFile dest
|
|
return ok
|
|
| otherwise = return False
|
|
where
|
|
params = Param "--reflink=always" : copyMetaDataParams meta
|
|
|
|
{- Create a hard link if the filesystem allows it, and fall back to copying
|
|
- the file. -}
|
|
createLinkOrCopy :: FilePath -> FilePath -> IO Bool
|
|
createLinkOrCopy src dest = go `catchIO` const fallback
|
|
where
|
|
go = do
|
|
createLink src dest
|
|
return True
|
|
fallback = copyFileExternal CopyAllMetaData src dest
|