diff options
author | Joey Hess <joeyh@joeyh.name> | 2021-06-29 13:28:25 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2021-06-29 13:28:25 -0400 |
commit | 2db8167ddbfa080b44509d4532d7d34887cdc64a (patch) | |
tree | 997c359eaac8297ac01374d96c012d64c4913407 /Utility/CopyFile.hs | |
parent | 84db819626232d789864780a52b63a787d49ef52 (diff) | |
download | git-repair-2db8167ddbfa080b44509d4532d7d34887cdc64a.tar.gz |
merge from git-annex
Fixes 2 bugs, one a data loss bug. It is possible to get those fixes
without merging all the other changes, if a backport is wanted.
Diffstat (limited to 'Utility/CopyFile.hs')
-rw-r--r-- | Utility/CopyFile.hs | 83 |
1 files changed, 83 insertions, 0 deletions
diff --git a/Utility/CopyFile.hs b/Utility/CopyFile.hs new file mode 100644 index 0000000..f851326 --- /dev/null +++ b/Utility/CopyFile.hs @@ -0,0 +1,83 @@ +{- 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 + - and preserving metadata. -} +copyFileExternal :: CopyMetaData -> FilePath -> FilePath -> IO Bool +copyFileExternal meta src dest = do + -- Delete any existing dest file because an unwritable file + -- would prevent cp from working. + void $ tryIO $ 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 + void $ tryIO $ removeFile dest + -- 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]) + { std_out = UseHandle nullh + , std_err = UseHandle nullh + } + in withCreateProcess p $ \_ _ _ -> checkSuccessProcess + -- 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 |