merge from git-annex

24 files changed, 312 insertions, 225 deletions

diff --git a/CHANGELOG b/CHANGELOG
index 3d0ca96..737693b 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -1,9 +1,9 @@
-git-repair (1.20210630) UNRELEASED; urgency=medium
+git-repair (1.20220404) unstable; urgency=medium
 
   * Avoid treating refs that are not commit objects as evidence of
     repository corruption.
 
- -- Joey Hess <id@joeyh.name>  Wed, 04 May 2022 11:33:48 -0400
+ -- Joey Hess <id@joeyh.name>  Wed, 04 May 2022 11:43:15 -0400
 
 git-repair (1.20210629) unstable; urgency=medium
 
diff --git a/COPYRIGHT b/COPYRIGHT
index cbd1cdc..08fb2ea 100644
--- a/COPYRIGHT
+++ b/COPYRIGHT
@@ -2,11 +2,11 @@ Format: https://www.debian.org/doc/packaging-manuals/copyright-format/1.0/
 Source: git://git-repair.branchable.com/
 
 Files: *
-Copyright: © 2013-2019 Joey Hess <joey@kitenet.net>
+Copyright: © 2013-2022 Joey Hess <joey@kitenet.net>
 License: AGPL-3+
 
 Files: Utility/*
-Copyright: 2012-2014 Joey Hess <joey@kitenet.net>
+Copyright: 2012-2022 Joey Hess <joey@kitenet.net>
 License: BSD-2-clause
 
 Files: Utility/Attoparsec.hs
diff --git a/Git/Branch.hs b/Git/Branch.hs
index 54af101..f30e357 100644
--- a/Git/Branch.hs
+++ b/Git/Branch.hs
@@ -121,6 +121,13 @@ fastForward branch (first:rest) repo =
 			(False, True) -> findbest c rs -- worse
 			(False, False) -> findbest c rs -- same
 
+{- Should the commit avoid the usual summary output? -}
+newtype CommitQuiet = CommitQuiet Bool
+
+applyCommitQuiet :: CommitQuiet -> [CommandParam] -> [CommandParam]
+applyCommitQuiet (CommitQuiet True) ps = Param "--quiet" : ps
+applyCommitQuiet (CommitQuiet False) ps = ps
+
 {- The user may have set commit.gpgsign, intending all their manual
  - commits to be signed. But signing automatic/background commits could
  - easily lead to unwanted gpg prompts or failures.
@@ -148,12 +155,14 @@ applyCommitModeForCommitTree commitmode ps r
 	ps' = applyCommitMode commitmode ps
 
 {- Commit via the usual git command. -}
-commitCommand :: CommitMode -> [CommandParam] -> Repo -> IO Bool
+commitCommand :: CommitMode -> CommitQuiet -> [CommandParam] -> Repo -> IO Bool
 commitCommand = commitCommand' runBool
 
-commitCommand' :: ([CommandParam] -> Repo -> IO a) -> CommitMode -> [CommandParam] -> Repo -> IO a
-commitCommand' runner commitmode ps = runner $
-	Param "commit" : applyCommitMode commitmode ps
+commitCommand' :: ([CommandParam] -> Repo -> IO a) -> CommitMode -> CommitQuiet -> [CommandParam] -> Repo -> IO a
+commitCommand' runner commitmode commitquiet ps =
+	runner $ Param "commit" : ps'
+  where
+	ps' = applyCommitMode commitmode (applyCommitQuiet commitquiet ps)
 
 {- Commits the index into the specified branch (or other ref), 
  - with the specified parent refs, and returns the committed sha.
@@ -162,7 +171,7 @@ commitCommand' runner commitmode ps = runner $
  - one parent, and it has the same tree that would be committed.
  -
  - Unlike git-commit, does not run any hooks, or examine the work tree
- - in any way.
+ - in any way, or output a summary.
  -}
 commit :: CommitMode -> Bool -> String -> Branch -> [Ref] -> Repo -> IO (Maybe Sha)
 commit commitmode allowempty message branch parentrefs repo = do
diff --git a/Git/CatFile.hs b/Git/CatFile.hs
index b9f8305..f33ad49 100644
--- a/Git/CatFile.hs
+++ b/Git/CatFile.hs
@@ -1,6 +1,6 @@
 {- git cat-file interface
  -
- - Copyright 2011-2020 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2021 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -10,9 +10,13 @@
 
 module Git.CatFile (
 	CatFileHandle,
+	CatFileMetaDataHandle,
 	catFileStart,
+	catFileMetaDataStart,
 	catFileStart',
+	catFileMetaDataStart',
 	catFileStop,
+	catFileMetaDataStop,
 	catFile,
 	catFileDetails,
 	catTree,
@@ -55,8 +59,12 @@ import Utility.Tuple
 
 data CatFileHandle = CatFileHandle 
 	{ catFileProcess :: CoProcess.CoProcessHandle
-	, checkFileProcess :: CoProcess.CoProcessHandle
-	, gitRepo :: Repo
+	, catFileGitRepo :: Repo
+	}
+
+data CatFileMetaDataHandle = CatFileMetaDataHandle
+	{ checkFileProcess :: CoProcess.CoProcessHandle
+	, checkFileGitRepo :: Repo
 	}
 
 catFileStart :: Repo -> IO CatFileHandle
@@ -64,22 +72,31 @@ catFileStart = catFileStart' True
 
 catFileStart' :: Bool -> Repo -> IO CatFileHandle
 catFileStart' restartable repo = CatFileHandle
-	<$> startp "--batch"
-	<*> startp ("--batch-check=" ++ batchFormat)
+	<$> startcat restartable repo "--batch"
+	<*> pure repo
+
+catFileMetaDataStart :: Repo -> IO CatFileMetaDataHandle
+catFileMetaDataStart = catFileMetaDataStart' True
+
+catFileMetaDataStart' :: Bool -> Repo -> IO CatFileMetaDataHandle
+catFileMetaDataStart' restartable repo = CatFileMetaDataHandle
+	<$> startcat restartable repo ("--batch-check=" ++ batchFormat)
 	<*> pure repo
-  where
-	startp p = gitCoProcessStart restartable
-		[ Param "cat-file"
-		, Param p
-		] repo
 
 batchFormat :: String
 batchFormat = "%(objectname) %(objecttype) %(objectsize)"
 
+startcat :: Bool -> Repo -> String -> IO CoProcess.CoProcessHandle
+startcat restartable repo p = gitCoProcessStart restartable
+	[ Param "cat-file"
+	, Param p
+	] repo
+
 catFileStop :: CatFileHandle -> IO ()
-catFileStop h = do
-	CoProcess.stop (catFileProcess h)
-	CoProcess.stop (checkFileProcess h)
+catFileStop = CoProcess.stop . catFileProcess
+
+catFileMetaDataStop :: CatFileMetaDataHandle -> IO ()
+catFileMetaDataStop = CoProcess.stop . checkFileProcess
 
 {- Reads a file from a specified branch. -}
 catFile :: CatFileHandle -> Branch -> RawFilePath -> IO L.ByteString
@@ -106,16 +123,16 @@ catObjectDetails h object = query (catFileProcess h) object newlinefallback $ \f
 		Nothing -> error $ "unknown response from git cat-file " ++ show (header, object)
   where
 	-- Slow fallback path for filenames containing newlines.
-	newlinefallback = queryObjectType object (gitRepo h) >>= \case
+	newlinefallback = queryObjectType object (catFileGitRepo h) >>= \case
 		Nothing -> return Nothing
-		Just objtype -> queryContent object (gitRepo h) >>= \case
+		Just objtype -> queryContent object (catFileGitRepo h) >>= \case
 			Nothing -> return Nothing
 			Just content -> do
 				-- only the --batch interface allows getting
 				-- the sha, so have to re-hash the object
 				sha <- hashObject' objtype
 					(flip L.hPut content)
-					(gitRepo h)
+					(catFileGitRepo h)
 				return (Just (content, sha, objtype))
 
 readObjectContent :: Handle -> ParsedResp -> IO L.ByteString
@@ -131,7 +148,7 @@ readObjectContent h (ParsedResp _ _ size) = do
 readObjectContent _ DNE = error "internal"
 
 {- Gets the size and type of an object, without reading its content. -}
-catObjectMetaData :: CatFileHandle -> Ref -> IO (Maybe (Sha, FileSize, ObjectType))
+catObjectMetaData :: CatFileMetaDataHandle -> Ref -> IO (Maybe (Sha, FileSize, ObjectType))
 catObjectMetaData h object = query (checkFileProcess h) object newlinefallback $ \from -> do
 	resp <- S8.hGetLine from
 	case parseResp object resp of
@@ -142,9 +159,9 @@ catObjectMetaData h object = query (checkFileProcess h) object newlinefallback $
   where
 	-- Slow fallback path for filenames containing newlines.
 	newlinefallback = do
-		sha <- Git.Ref.sha object (gitRepo h)
-		sz <- querySize object (gitRepo h)
-		objtype <- queryObjectType object (gitRepo h)
+		sha <- Git.Ref.sha object (checkFileGitRepo h)
+		sz <- querySize object (checkFileGitRepo h)
+		objtype <- queryObjectType object (checkFileGitRepo h)
 		return $ (,,) <$> sha <*> sz <*> objtype
 
 data ParsedResp = ParsedResp Sha ObjectType FileSize | DNE
diff --git a/Git/Command.hs b/Git/Command.hs
index 2358b17..894f6ae 100644
--- a/Git/Command.hs
+++ b/Git/Command.hs
@@ -39,7 +39,7 @@ runBool params repo = assertLocal repo $
 run :: [CommandParam] -> Repo -> IO ()
 run params repo = assertLocal repo $
 	unlessM (runBool params repo) $
-		error $ "git " ++ show params ++ " failed"
+		giveup $ "git " ++ show params ++ " failed"
 
 {- Runs git and forces it to be quiet, throwing an error if it fails. -}
 runQuiet :: [CommandParam] -> Repo -> IO ()
diff --git a/Git/Config.hs b/Git/Config.hs
index 20ddf79..5deba6b 100644
--- a/Git/Config.hs
+++ b/Git/Config.hs
@@ -170,7 +170,7 @@ parse s st
 
 {- Checks if a string from git config is a true/false value. -}
 isTrueFalse :: String -> Maybe Bool
-isTrueFalse = isTrueFalse' . ConfigValue . encodeBS'
+isTrueFalse = isTrueFalse' . ConfigValue . encodeBS
 
 isTrueFalse' :: ConfigValue -> Maybe Bool
 isTrueFalse' (ConfigValue s)
@@ -241,6 +241,14 @@ fromFile r f = fromPipe r "git"
 	, Param "--list"
 	] ConfigList
 
+{- Changes a git config setting in .git/config. -}
+change :: ConfigKey -> S.ByteString -> Repo -> IO Bool
+change (ConfigKey k) v = Git.Command.runBool
+	[ Param "config"
+	, Param (decodeBS k)
+	, Param (decodeBS v)
+	]
+
 {- Changes a git config setting in the specified config file.
  - (Creates the file if it does not already exist.) -}
 changeFile :: FilePath -> ConfigKey -> S.ByteString -> IO Bool
@@ -248,8 +256,8 @@ changeFile f (ConfigKey k) v = boolSystem "git"
 	[ Param "config"
 	, Param "--file"
 	, File f
-	, Param (decodeBS' k)
-	, Param (decodeBS' v)
+	, Param (decodeBS k)
+	, Param (decodeBS v)
 	]
 
 {- Unsets a git config setting, in both the git repo,
@@ -264,4 +272,4 @@ unset ck@(ConfigKey k) r = ifM (Git.Command.runBool ps r)
 	, return Nothing
 	)
   where
-	ps = [Param "config", Param "--unset-all", Param (decodeBS' k)]
+	ps = [Param "config", Param "--unset-all", Param (decodeBS k)]
diff --git a/Git/Construct.hs b/Git/Construct.hs
index c013eb2..a5e825e 100644
--- a/Git/Construct.hs
+++ b/Git/Construct.hs
@@ -184,7 +184,10 @@ expandTilde :: FilePath -> IO FilePath
 #ifdef mingw32_HOST_OS
 expandTilde = return
 #else
-expandTilde = expandt True
+expandTilde p = expandt True p
+	-- If unable to expand a tilde, eg due to a user not existing,
+	-- use the path as given.
+	`catchNonAsync` (const (return p))
   where
 	expandt _ [] = return ""
 	expandt _ ('/':cs) = do
diff --git a/Git/LsFiles.hs b/Git/LsFiles.hs
index 297c068..cc824f2 100644
--- a/Git/LsFiles.hs
+++ b/Git/LsFiles.hs
@@ -5,6 +5,8 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
+{-# LANGUAGE OverloadedStrings #-}
+
 module Git.LsFiles (
 	Options(..),
 	inRepo,
@@ -66,7 +68,7 @@ safeForLsFiles r = isNothing (remoteName r)
 guardSafeForLsFiles :: Repo -> IO a -> IO a
 guardSafeForLsFiles r a
 	| safeForLsFiles r = a
-	| otherwise = error $ "git ls-files is unsafe to run on repository " ++ repoDescribe r
+	| otherwise = giveup $ "git ls-files is unsafe to run on repository " ++ repoDescribe r
 
 data Options = ErrorUnmatch
 
@@ -236,7 +238,14 @@ data Unmerged = Unmerged
 	{ unmergedFile :: RawFilePath
 	, unmergedTreeItemType :: Conflicting TreeItemType
 	, unmergedSha :: Conflicting Sha
-	}
+	, unmergedSiblingFile :: Maybe RawFilePath
+	-- ^ Normally this is Nothing, because a
+	-- merge conflict is represented as a single file with two
+	-- stages. However, git resolvers sometimes choose to stage
+	-- two files, one for each side of the merge conflict. In such a case,
+	-- this is used for the name of the second file, which is related
+	-- to the first file. (Eg, "foo" and "foo~ref")
+	} deriving (Show)
 
 {- Returns a list of the files in the specified locations that have
  - unresolved merge conflicts.
@@ -246,12 +255,12 @@ data Unmerged = Unmerged
  -   1 = old version, can be ignored
  -   2 = us
  -   3 = them
- - If a line is omitted, that side removed the file.
+ - If line 2 or 3 is omitted, that side removed the file.
  -}
 unmerged :: [RawFilePath] -> Repo -> IO ([Unmerged], IO Bool)
 unmerged l repo = guardSafeForLsFiles repo $ do
 	(fs, cleanup) <- pipeNullSplit params repo
-	return (reduceUnmerged [] $ catMaybes $ map (parseUnmerged . decodeBL') fs, cleanup)
+	return (reduceUnmerged [] $ catMaybes $ map (parseUnmerged . decodeBL) fs, cleanup)
   where
 	params = 
 		Param "ls-files" :
@@ -265,7 +274,7 @@ data InternalUnmerged = InternalUnmerged
 	, ifile :: RawFilePath
 	, itreeitemtype :: Maybe TreeItemType
 	, isha :: Maybe Sha
-	}
+	} deriving (Show)
 
 parseUnmerged :: String -> Maybe InternalUnmerged
 parseUnmerged s
@@ -277,7 +286,7 @@ parseUnmerged s
 				then Nothing
 				else do
 					treeitemtype <- readTreeItemType (encodeBS rawtreeitemtype)
-					sha <- extractSha (encodeBS' rawsha)
+					sha <- extractSha (encodeBS rawsha)
 					return $ InternalUnmerged (stage == 2) (toRawFilePath file)
 						(Just treeitemtype) (Just sha)
 		_ -> Nothing
@@ -296,16 +305,25 @@ reduceUnmerged c (i:is) = reduceUnmerged (new:c) rest
 		{ unmergedFile = ifile i
 		, unmergedTreeItemType = Conflicting treeitemtypeA treeitemtypeB
 		, unmergedSha = Conflicting shaA shaB
+		, unmergedSiblingFile = if ifile sibi == ifile i
+			then Nothing
+			else Just (ifile sibi)
 		}
 	findsib templatei [] = ([], removed templatei)
 	findsib templatei (l:ls)
-		| ifile l == ifile templatei = (ls, l)
+		| ifile l == ifile templatei || issibfile templatei l = (ls, l)
 		| otherwise = (l:ls, removed templatei)
 	removed templatei = templatei
 		{ isus = not (isus templatei)
 		, itreeitemtype = Nothing
 		, isha = Nothing
 		}
+	-- foo~<ref> are unmerged sibling files of foo
+	-- Some versions or resolvers of git stage the sibling files,
+	-- other versions or resolvers do not.
+	issibfile x y = (ifile x <> "~") `S.isPrefixOf` ifile y
+		&& isus x || isus y
+		&& not (isus x && isus y)
 
 {- Gets the InodeCache equivilant information stored in the git index.
  -
diff --git a/Git/LsTree.hs b/Git/LsTree.hs
index a49c4ea..fb3b3e1 100644
--- a/Git/LsTree.hs
+++ b/Git/LsTree.hs
@@ -149,7 +149,7 @@ parserLsTree long = case long of
  - generated, so any size information is not included. -}
 formatLsTree :: TreeItem -> S.ByteString
 formatLsTree ti = S.intercalate (S.singleton (fromIntegral (ord ' ')))
-	[ encodeBS' (showOct (mode ti) "")
+	[ encodeBS (showOct (mode ti) "")
 	, typeobj ti
 	, fromRef' (sha ti)
 	] <> (S.cons (fromIntegral (ord '\t')) (getTopFilePath (file ti)))
diff --git a/Git/Ref.hs b/Git/Ref.hs
index 6929a8e..2d2874a 100644
--- a/Git/Ref.hs
+++ b/Git/Ref.hs
@@ -64,17 +64,21 @@ branchRef = underBase "refs/heads"
 
 {- A Ref that can be used to refer to a file in the repository, as staged
  - in the index.
+ - 
+ - If the input file is located outside the repository, returns Nothing.
  -}
-fileRef :: RawFilePath -> IO Ref
-fileRef f = do
+fileRef :: RawFilePath -> Repo -> IO (Maybe Ref)
+fileRef f repo = do
 	-- The filename could be absolute, or contain eg "../repo/file",
 	-- neither of which work in a ref, so convert it to a minimal
 	-- relative path.
 	f' <- relPathCwdToFile f
- 	-- Prefixing the file with ./ makes this work even when in a
-	-- subdirectory of a repo. Eg, ./foo in directory bar refers
-	-- to bar/foo, not to foo in the top of the repository.
-	return $ Ref $ ":./" <> toInternalGitPath f'
+	return $ if repoPath repo `dirContains` f'
+ 		-- Prefixing the file with ./ makes this work even when in a
+		-- subdirectory of a repo. Eg, ./foo in directory bar refers
+		-- to bar/foo, not to foo in the top of the repository.
+		then Just $ Ref $ ":./" <> toInternalGitPath f'
+		else Nothing
 
 {- A Ref that can be used to refer to a file in a particular branch. -}
 branchFileRef :: Branch -> RawFilePath -> Ref
@@ -82,14 +86,17 @@ branchFileRef branch f = Ref $ fromRef' branch <> ":" <> toInternalGitPath f
 
 {- Converts a Ref to refer to the content of the Ref on a given date. -}
 dateRef :: Ref -> RefDate -> Ref
-dateRef r (RefDate d) = Ref $ fromRef' r <> "@" <> encodeBS' d
+dateRef r (RefDate d) = Ref $ fromRef' r <> "@" <> encodeBS d
 
 {- A Ref that can be used to refer to a file in the repository as it
- - appears in a given Ref. -}
-fileFromRef :: Ref -> RawFilePath -> IO Ref
-fileFromRef r f = do
-	(Ref fr) <- fileRef f
-	return (Ref (fromRef' r <> fr))
+ - appears in a given Ref. 
+ -
+ - If the file path is located outside the repository, returns Nothing.
+ -}
+fileFromRef :: Ref -> RawFilePath -> Repo -> IO (Maybe Ref)
+fileFromRef r f repo = fileRef f repo >>= return . \case
+	Just (Ref fr) -> Just (Ref (fromRef' r <> fr))
+	Nothing -> Nothing
 
 {- Checks if a ref exists. Note that it must be fully qualified,
  - eg refs/heads/master rather than master. -}
@@ -177,7 +184,7 @@ tree (Ref ref) = extractSha <$$> pipeReadStrict
 	[ Param "rev-parse"
 	, Param "--verify"
 	, Param "--quiet"
-	, Param (decodeBS' ref')
+	, Param (decodeBS ref')
 	]
   where
 	ref' = if ":" `S.isInfixOf` ref
diff --git a/Git/Remote.hs b/Git/Remote.hs
index 8f5d99f..80accca 100644
--- a/Git/Remote.hs
+++ b/Git/Remote.hs
@@ -37,7 +37,7 @@ remoteKeyToRemoteName :: ConfigKey -> Maybe RemoteName
 remoteKeyToRemoteName (ConfigKey k)
 	| "remote." `S.isPrefixOf` k = 
 		let n = S.intercalate "." $ dropFromEnd 1 $ drop 1 $ S8.split '.' k
-		in if S.null n then Nothing else Just (decodeBS' n)
+		in if S.null n then Nothing else Just (decodeBS n)
 	| otherwise = Nothing
 
 {- Construct a legal git remote name out of an arbitrary input string.
@@ -90,7 +90,7 @@ parseRemoteLocation s repo = ret $ calcloc s
 		| null insteadofs = l
 		| otherwise = replacement ++ drop (S.length bestvalue) l
 	  where
-		replacement = decodeBS' $ S.drop (S.length prefix) $
+		replacement = decodeBS $ S.drop (S.length prefix) $
 			S.take (S.length bestkey - S.length suffix) bestkey
 		(bestkey, bestvalue) = 
 			case maximumBy longestvalue insteadofs of
diff --git a/Git/Types.hs b/Git/Types.hs
index db1c71b..68045fc 100644
--- a/Git/Types.hs
+++ b/Git/Types.hs
@@ -75,7 +75,7 @@ instance Default ConfigValue where
 	def = ConfigValue mempty
 
 fromConfigKey :: ConfigKey -> String
-fromConfigKey (ConfigKey s) = decodeBS' s
+fromConfigKey (ConfigKey s) = decodeBS s
 
 instance Show ConfigKey where
 	show = fromConfigKey
@@ -88,16 +88,16 @@ instance FromConfigValue S.ByteString where
 	fromConfigValue NoConfigValue = mempty
 
 instance FromConfigValue String where
-	fromConfigValue = decodeBS' . fromConfigValue
+	fromConfigValue = decodeBS . fromConfigValue
 
 instance Show ConfigValue where
 	show = fromConfigValue
 
 instance IsString ConfigKey where
-	fromString = ConfigKey . encodeBS'
+	fromString = ConfigKey . encodeBS
 
 instance IsString ConfigValue where
-	fromString = ConfigValue . encodeBS'
+	fromString = ConfigValue . encodeBS
 
 type RemoteName = String
 
@@ -106,7 +106,7 @@ newtype Ref = Ref S.ByteString
 	deriving (Eq, Ord, Read, Show)
 
 fromRef :: Ref -> String
-fromRef = decodeBS' . fromRef'
+fromRef = decodeBS . fromRef'
 
 fromRef' :: Ref -> S.ByteString
 fromRef' (Ref s) = s
diff --git a/Git/UpdateIndex.hs b/Git/UpdateIndex.hs
index 8e406b1..74816a6 100644
--- a/Git/UpdateIndex.hs
+++ b/Git/UpdateIndex.hs
@@ -80,14 +80,14 @@ lsTree (Ref x) repo streamer = do
 	mapM_ streamer s
 	void $ cleanup
   where
-	params = map Param ["ls-tree", "-z", "-r", "--full-tree", decodeBS' x]
+	params = map Param ["ls-tree", "-z", "-r", "--full-tree", decodeBS x]
 lsSubTree :: Ref -> FilePath -> Repo -> Streamer
 lsSubTree (Ref x) p repo streamer = do
 	(s, cleanup) <- pipeNullSplit params repo
 	mapM_ streamer s
 	void $ cleanup
   where
-	params = map Param ["ls-tree", "-z", "-r", "--full-tree", decodeBS' x, p]
+	params = map Param ["ls-tree", "-z", "-r", "--full-tree", decodeBS x, p]
 
 {- Generates a line suitable to be fed into update-index, to add
  - a given file with a given sha. -}
diff --git a/Utility/CopyFile.hs b/Utility/CopyFile.hs
index f851326..9c93e70 100644
--- a/Utility/CopyFile.hs
+++ b/Utility/CopyFile.hs
@@ -1,6 +1,6 @@
 {- file copying
  -
- - Copyright 2010-2019 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2021 Joey Hess <id@joeyh.name>
  -
  - License: BSD-2-clause
  -}
@@ -30,6 +30,12 @@ copyMetaDataParams meta = map snd $ filter fst
 		, Param "-p")
 	, (not allmeta && BuildInfo.cp_preserve_timestamps
 		, Param "--preserve=timestamps")
+	-- cp -a may preserve xattrs that have special meaning,
+	-- eg to NFS, and have even been observed to prevent later
+	-- changing the permissions of the file. So prevent preserving
+	-- xattrs.
+	, (allmeta && BuildInfo.cp_a && BuildInfo.cp_no_preserve_xattr_supported
+		, Param "--no-preserve=xattr")
 	]
   where
 	allmeta = meta == CopyAllMetaData
@@ -50,11 +56,17 @@ copyFileExternal meta src dest = do
 		| otherwise = copyMetaDataParams meta
 
 {- When a filesystem supports CoW (and cp does), uses it to make
- - an efficient copy of a file. Otherwise, returns False. -}
+ - an efficient copy of a file. Otherwise, returns False.
+ -
+ - The dest file must not exist yet, or it will fail to make a CoW copy,
+ - and will return False.
+ -
+ - Note that in coreutil 9.0, cp uses CoW by default, without needing an
+ - option. This code is only needed to support older versions.
+ -}
 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 ->
diff --git a/Utility/Data.hs b/Utility/Data.hs
index 5510845..faf9b34 100644
--- a/Utility/Data.hs
+++ b/Utility/Data.hs
@@ -1,6 +1,6 @@
 {- utilities for simple data types
  -
- - Copyright 2013 Joey Hess <id@joeyh.name>
+ - Copyright 2013-2021 Joey Hess <id@joeyh.name>
  -
  - License: BSD-2-clause
  -}
@@ -10,8 +10,12 @@
 module Utility.Data (
 	firstJust,
 	eitherToMaybe,
+	s2w8,
+	w82s,
 ) where
 
+import Data.Word
+
 {- First item in the list that is not Nothing. -}
 firstJust :: Eq a => [Maybe a] -> Maybe a
 firstJust ms = case dropWhile (== Nothing) ms of
@@ -20,3 +24,15 @@ firstJust ms = case dropWhile (== Nothing) ms of
 
 eitherToMaybe :: Either a b -> Maybe b
 eitherToMaybe = either (const Nothing) Just
+
+c2w8 :: Char -> Word8
+c2w8 = fromIntegral . fromEnum
+
+w82c :: Word8 -> Char
+w82c = toEnum . fromIntegral
+
+s2w8 :: String -> [Word8]
+s2w8 = map c2w8
+
+w82s :: [Word8] -> String
+w82s = map w82c
diff --git a/Utility/Debug.hs b/Utility/Debug.hs
index e0be9c9..6e6e701 100644
--- a/Utility/Debug.hs
+++ b/Utility/Debug.hs
@@ -34,7 +34,7 @@ newtype DebugSource = DebugSource S.ByteString
 	deriving (Eq, Show)
 
 instance IsString DebugSource where
-	fromString = DebugSource . encodeBS'
+	fromString = DebugSource . encodeBS
 
 -- | Selects whether to display a message from a source.
 data DebugSelector 
@@ -97,6 +97,6 @@ fastDebug (DebugSelector p) src msg
 
 formatDebugMessage :: DebugSource -> String -> IO S.ByteString
 formatDebugMessage (DebugSource src) msg = do
-	t <- encodeBS' . formatTime defaultTimeLocale "[%F %X%Q]"
+	t <- encodeBS . formatTime defaultTimeLocale "[%F %X%Q]"
 		<$> getZonedTime
 	return (t <> " (" <> src <> ") " <> encodeBS msg)
diff --git a/Utility/FileSystemEncoding.hs b/Utility/FileSystemEncoding.hs
index 1f7c76b..2a1dc81 100644
--- a/Utility/FileSystemEncoding.hs
+++ b/Utility/FileSystemEncoding.hs
@@ -1,6 +1,6 @@
 {- GHC File system encoding handling.
  -
- - Copyright 2012-2016 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2021 Joey Hess <id@joeyh.name>
  -
  - License: BSD-2-clause
  -}
@@ -11,7 +11,6 @@
 module Utility.FileSystemEncoding (
 	useFileSystemEncoding,
 	fileEncoding,
-	withFilePath,
 	RawFilePath,
 	fromRawFilePath,
 	toRawFilePath,
@@ -19,36 +18,22 @@ module Utility.FileSystemEncoding (
 	encodeBL,
 	decodeBS,
 	encodeBS,
-	decodeBL',
-	encodeBL',
-	decodeBS',
-	encodeBS',
 	truncateFilePath,
-	s2w8,
-	w82s,
-	c2w8,
-	w82c,
 ) where
 
 import qualified GHC.Foreign as GHC
 import qualified GHC.IO.Encoding as Encoding
-import Foreign.C
 import System.IO
 import System.IO.Unsafe
-import Data.Word
 import System.FilePath.ByteString (RawFilePath, encodeFilePath, decodeFilePath)
 import qualified Data.ByteString as S
 import qualified Data.ByteString.Lazy as L
+import Data.ByteString.Unsafe (unsafePackMallocCStringLen)
 #ifdef mingw32_HOST_OS
 import qualified Data.ByteString.UTF8 as S8
 import qualified Data.ByteString.Lazy.UTF8 as L8
-#else
-import Data.List
-import Utility.Split
 #endif
 
-import Utility.Exception
-
 {- Makes all subsequent Handles that are opened, as well as stdio Handles,
  - use the filesystem encoding, instead of the encoding of the current
  - locale.
@@ -81,40 +66,10 @@ fileEncoding h = hSetEncoding h =<< Encoding.getFileSystemEncoding
 fileEncoding h = hSetEncoding h Encoding.utf8
 #endif
 
-{- Marshal a Haskell FilePath into a NUL terminated C string using temporary
- - storage. The FilePath is encoded using the filesystem encoding,
- - reversing the decoding that should have been done when the FilePath
- - was obtained. -}
-withFilePath :: FilePath -> (CString -> IO a) -> IO a
-withFilePath fp f = Encoding.getFileSystemEncoding
-	>>= \enc -> GHC.withCString enc fp f
-
-{- Encodes a FilePath into a String, applying the filesystem encoding.
- -
- - There are very few things it makes sense to do with such an encoded
- - string. It's not a legal filename; it should not be displayed.
- - So this function is not exported, but instead used by the few functions
- - that can usefully consume it.
- -
- - This use of unsafePerformIO is belived to be safe; GHC's interface
- - only allows doing this conversion with CStrings, and the CString buffer
- - is allocated, used, and deallocated within the call, with no side
- - effects.
- -
- - If the FilePath contains a value that is not legal in the filesystem
- - encoding, rather than thowing an exception, it will be returned as-is.
- -}
-{-# NOINLINE _encodeFilePath #-}
-_encodeFilePath :: FilePath -> String
-_encodeFilePath fp = unsafePerformIO $ do
-	enc <- Encoding.getFileSystemEncoding
-	GHC.withCString enc fp (GHC.peekCString Encoding.char8)
-		`catchNonAsync` (\_ -> return fp)
-
 {- Decodes a ByteString into a FilePath, applying the filesystem encoding. -}
 decodeBL :: L.ByteString -> FilePath
 #ifndef mingw32_HOST_OS
-decodeBL = encodeW8NUL . L.unpack
+decodeBL = decodeBS . L.toStrict
 #else
 {- On Windows, we assume that the ByteString is utf-8, since Windows
  - only uses unicode for filenames. -}
@@ -124,104 +79,45 @@ decodeBL = L8.toString
 {- Encodes a FilePath into a ByteString, applying the filesystem encoding. -}
 encodeBL :: FilePath -> L.ByteString
 #ifndef mingw32_HOST_OS
-encodeBL = L.pack . decodeW8NUL
+encodeBL = L.fromStrict . encodeBS
 #else
 encodeBL = L8.fromString
 #endif
 
 decodeBS :: S.ByteString -> FilePath
 #ifndef mingw32_HOST_OS
-decodeBS = encodeW8NUL . S.unpack
+-- This does the same thing as System.FilePath.ByteString.decodeFilePath,
+-- with an identical implementation. However, older versions of that library
+-- truncated at NUL, which this must not do, because it may end up used on
+-- something other than a unix filepath.
+{-# NOINLINE decodeBS #-}
+decodeBS b = unsafePerformIO $ do
+	enc <- Encoding.getFileSystemEncoding
+	S.useAsCStringLen b (GHC.peekCStringLen enc)
 #else
 decodeBS = S8.toString
 #endif
 
 encodeBS :: FilePath -> S.ByteString
 #ifndef mingw32_HOST_OS
-encodeBS = S.pack . decodeW8NUL
+-- This does the same thing as System.FilePath.ByteString.encodeFilePath,
+-- with an identical implementation. However, older versions of that library
+-- truncated at NUL, which this must not do, because it may end up used on
+-- something other than a unix filepath.
+{-# NOINLINE encodeBS #-}
+encodeBS f = unsafePerformIO $ do
+	enc <- Encoding.getFileSystemEncoding
+	GHC.newCStringLen enc f >>= unsafePackMallocCStringLen
 #else
 encodeBS = S8.fromString
 #endif
 
-{- Faster version that assumes the string does not contain NUL;
- - if it does it will be truncated before the NUL. -}
-decodeBS' :: S.ByteString -> FilePath
-#ifndef mingw32_HOST_OS
-decodeBS' = encodeW8 . S.unpack
-#else
-decodeBS' = S8.toString
-#endif
-
-encodeBS' :: FilePath -> S.ByteString
-#ifndef mingw32_HOST_OS
-encodeBS' = S.pack . decodeW8
-#else
-encodeBS' = S8.fromString
-#endif
-
-decodeBL' :: L.ByteString -> FilePath
-#ifndef mingw32_HOST_OS
-decodeBL' = encodeW8 . L.unpack
-#else
-decodeBL' = L8.toString
-#endif
-
-encodeBL' :: FilePath -> L.ByteString
-#ifndef mingw32_HOST_OS
-encodeBL' = L.pack . decodeW8
-#else
-encodeBL' = L8.fromString
-#endif
-
 fromRawFilePath :: RawFilePath -> FilePath
 fromRawFilePath = decodeFilePath
 
 toRawFilePath :: FilePath -> RawFilePath
 toRawFilePath = encodeFilePath
 
-#ifndef mingw32_HOST_OS
-{- Converts a [Word8] to a FilePath, encoding using the filesystem encoding.
- -
- - w82s produces a String, which may contain Chars that are invalid
- - unicode. From there, this is really a simple matter of applying the
- - file system encoding, only complicated by GHC's interface to doing so.
- -
- - Note that the encoding stops at any NUL in the input. FilePaths
- - cannot contain embedded NUL, but Haskell Strings may.
- -}
-{-# NOINLINE encodeW8 #-}
-encodeW8 :: [Word8] -> FilePath
-encodeW8 w8 = unsafePerformIO $ do
-	enc <- Encoding.getFileSystemEncoding
-	GHC.withCString Encoding.char8 (w82s w8) $ GHC.peekCString enc
-
-decodeW8 :: FilePath -> [Word8]
-decodeW8 = s2w8 . _encodeFilePath
-
-{- Like encodeW8 and decodeW8, but NULs are passed through unchanged. -}
-encodeW8NUL :: [Word8] -> FilePath
-encodeW8NUL = intercalate [nul] . map encodeW8 . splitc (c2w8 nul)
-  where
-	nul = '\NUL'
-
-decodeW8NUL :: FilePath -> [Word8]
-decodeW8NUL = intercalate [c2w8 nul] . map decodeW8 . splitc nul
-  where
-	nul = '\NUL'
-#endif
-
-c2w8 :: Char -> Word8
-c2w8 = fromIntegral . fromEnum
-
-w82c :: Word8 -> Char
-w82c = toEnum . fromIntegral
-
-s2w8 :: String -> [Word8]
-s2w8 = map c2w8
-
-w82s :: [Word8] -> String
-w82s = map w82c
-
 {- Truncates a FilePath to the given number of bytes (or less),
  - as represented on disk.
  -
@@ -233,8 +129,8 @@ truncateFilePath :: Int -> FilePath -> FilePath
 truncateFilePath n = go . reverse
   where
 	go f =
-		let bytes = decodeW8 f
-		in if length bytes <= n
+		let b = encodeBS f
+		in if S.length b <= n
 			then reverse f
 			else go (drop 1 f)
 #else
diff --git a/Utility/HumanNumber.hs b/Utility/HumanNumber.hs
index 6143cef..04a18b0 100644
--- a/Utility/HumanNumber.hs
+++ b/Utility/HumanNumber.hs
@@ -1,6 +1,6 @@
 {- numbers for humans
  -
- - Copyright 2012-2013 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2021 Joey Hess <id@joeyh.name>
  -
  - License: BSD-2-clause
  -}
@@ -11,11 +11,15 @@ module Utility.HumanNumber (showImprecise) where
  - of decimal digits. -}
 showImprecise :: RealFrac a => Int -> a -> String
 showImprecise precision n
-	| precision == 0 || remainder == 0 = show (round n :: Integer)
-	| otherwise = show int ++ "." ++ striptrailing0s (pad0s $ show remainder)
+	| precision == 0 || remainder' == 0 = show (round n :: Integer)
+	| otherwise = show int' ++ "." ++ striptrailing0s (pad0s $ show remainder')
   where
 	int :: Integer
 	(int, frac) = properFraction n
 	remainder = round (frac * 10 ^ precision) :: Integer
+	(int', remainder')
+		-- carry the 1
+		| remainder == 10 ^ precision = (int + 1, 0)
+		| otherwise = (int, remainder)
 	pad0s s = replicate (precision - length s) '0' ++ s
 	striptrailing0s = reverse . dropWhile (== '0') . reverse
diff --git a/Utility/InodeCache.hs b/Utility/InodeCache.hs
index 9a21c63..b697ab3 100644
--- a/Utility/InodeCache.hs
+++ b/Utility/InodeCache.hs
@@ -55,7 +55,7 @@ import Data.Time.Clock.POSIX
 #ifdef mingw32_HOST_OS
 import Data.Word (Word64)
 #else
-import System.Posix.Files
+import qualified System.Posix.Files as Posix
 #endif
 
 data InodeCachePrim = InodeCachePrim FileID FileSize MTime
@@ -200,7 +200,7 @@ toInodeCache' (TSDelta getdelta) f s inode
 #ifdef mingw32_HOST_OS
 		mtime <- utcTimeToPOSIXSeconds <$> getModificationTime (fromRawFilePath f)
 #else
-		let mtime = modificationTimeHiRes s
+		let mtime = Posix.modificationTimeHiRes s
 #endif
 		return $ Just $ InodeCache $ InodeCachePrim inode sz (MTimeHighRes (mtime + highResTime delta))
 	| otherwise = pure Nothing
@@ -300,11 +300,6 @@ instance Arbitrary MTime where
                 , (50, MTimeHighRes <$> arbitrary)
 		]
 
-#ifdef mingw32_HOST_OS
-instance Arbitrary FileID where
-	arbitrary = fromIntegral <$> (arbitrary :: Gen Word64)
-#endif
-
 prop_read_show_inodecache :: InodeCache -> Bool
 prop_read_show_inodecache c = case readInodeCache (showInodeCache c) of
 	Nothing -> False
diff --git a/Utility/Metered.hs b/Utility/Metered.hs
index a7c9c37..8fd9c9b 100644
--- a/Utility/Metered.hs
+++ b/Utility/Metered.hs
@@ -37,6 +37,7 @@ module Utility.Metered (
 	demeterCommandEnv,
 	avoidProgress,
 	rateLimitMeterUpdate,
+	bwLimitMeterUpdate,
 	Meter,
 	mkMeter,
 	setMeterTotalSize,
@@ -51,6 +52,7 @@ import Utility.Percentage
 import Utility.DataUnits
 import Utility.HumanTime
 import Utility.SimpleProtocol as Proto
+import Utility.ThreadScheduler
 
 import qualified Data.ByteString.Lazy as L
 import qualified Data.ByteString as S
@@ -380,6 +382,46 @@ rateLimitMeterUpdate delta (Meter totalsizev _ _ _) meterupdate = do
 					meterupdate n
 				else putMVar lastupdate prev
 
+-- | Bandwidth limiting by inserting a delay at the point that a meter is
+-- updated.
+--
+-- This will only work when the actions that use bandwidth are run in the
+-- same process and thread as the call to the MeterUpdate.
+--
+-- For example, if the desired bandwidth is 100kb/s, and over the past
+-- 1/10th of a second, 30kb was sent, then the current bandwidth is
+-- 300kb/s, 3x as fast as desired. So, after getting the next chunk,
+-- pause for twice as long as it took to get it.
+bwLimitMeterUpdate :: ByteSize -> Duration -> MeterUpdate -> IO MeterUpdate
+bwLimitMeterUpdate bwlimit duration meterupdate
+	| bwlimit <= 0 = return meterupdate
+	| otherwise = do
+		nowtime <- getPOSIXTime
+		mv <- newMVar (nowtime, Nothing)
+		return (mu mv)
+  where
+	mu mv n@(BytesProcessed i) = do
+		endtime <- getPOSIXTime
+		(starttime, mprevi) <- takeMVar mv
+
+		case mprevi of
+			Just previ -> do
+				let runtime = endtime - starttime
+				let currbw = fromIntegral (i - previ) / runtime
+				let pausescale = if currbw > bwlimit'
+					then (currbw / bwlimit') - 1
+					else 0
+				unboundDelay (floor (runtime * pausescale * msecs))
+			Nothing -> return ()
+
+		meterupdate n
+
+		nowtime <- getPOSIXTime
+		putMVar mv (nowtime, Just i)
+
+	bwlimit' = fromIntegral (bwlimit * durationSeconds duration) 
+	msecs = fromIntegral oneSecond
+
 data Meter = Meter (MVar (Maybe TotalSize)) (MVar MeterState) (MVar String) DisplayMeter
 
 data MeterState = MeterState
@@ -417,12 +459,14 @@ updateMeter (Meter totalsizev sv bv displaymeter) new = do
 -- | Display meter to a Handle.
 displayMeterHandle :: Handle -> RenderMeter -> DisplayMeter
 displayMeterHandle h rendermeter v msize old new = do
+	olds <- takeMVar v
 	let s = rendermeter msize old new
-	olds <- swapMVar v s
+	let padding = replicate (length olds - length s) ' '
+	let s' = s <> padding
+	putMVar v s'
 	-- Avoid writing when the rendered meter has not changed.
-	when (olds /= s) $ do
-		let padding = replicate (length olds - length s) ' '
-		hPutStr h ('\r':s ++ padding)
+	when (olds /= s') $ do
+		hPutStr h ('\r':s')
 		hFlush h
 
 -- | Clear meter displayed by displayMeterHandle. May be called before
diff --git a/Utility/Path.hs b/Utility/Path.hs
index cfda748..b5aeb16 100644
--- a/Utility/Path.hs
+++ b/Utility/Path.hs
@@ -95,13 +95,49 @@ upFrom dir
 dirContains :: RawFilePath -> RawFilePath -> Bool
 dirContains a b = a == b
 	|| a' == b'
-	|| (addTrailingPathSeparator a') `B.isPrefixOf` b'
-	|| a' == "." && normalise ("." </> b') == b'
+	|| (a'' `B.isPrefixOf` b' && avoiddotdotb)
+	|| a' == "." && normalise ("." </> b') == b' && nodotdot b'
+	|| dotdotcontains
   where
 	a' = norm a
+	a'' = addTrailingPathSeparator a'
 	b' = norm b
 	norm = normalise . simplifyPath
 
+	{- This handles the case where a is ".." and b is "../..",
+	 - which is not inside a. Similarly, "../.." does not contain
+	 - "../../../". Due to the use of norm, cases like 
+	 - "../../foo/../../" get converted to eg "../../.." and
+	 - so do not need to be handled specially here.
+	 -
+	 - When this is called, we already know that 
+	 - a'' is a prefix of b', so all that needs to be done is drop
+	 - that prefix, and check if the next path component is ".."
+	 -}
+	avoiddotdotb = nodotdot $ B.drop (B.length a'') b'
+
+	nodotdot p = all (not . isdotdot) (splitPath p)
+	
+	isdotdot s = dropTrailingPathSeparator s == ".."
+
+	{- This handles the case where a is ".." or "../.." etc,
+	 - and b is "foo" or "../foo" etc. The rule is that when
+	 - a is entirely ".." components, b is under it when it starts
+	 - with fewer ".." components. 
+	 - 
+	 - Due to the use of norm, cases like "../../foo/../../" get
+	 - converted to eg "../../../" and so do not need to be handled
+	 - specially here.
+	 -}
+	dotdotcontains
+		| isAbsolute b' = False
+		| otherwise = 
+			let aps = splitPath a'
+			    bps = splitPath b'
+			in if all isdotdot aps
+				then length (takeWhile isdotdot bps) < length aps
+				else False
+
 {- Given an original list of paths, and an expanded list derived from it,
  - which may be arbitrarily reordered, generates a list of lists, where
  - each sublist corresponds to one of the original paths.
@@ -187,7 +223,13 @@ relPathDirToFileAbs from to
 	dotdots = replicate (length pfrom - numcommon) ".."
 	numcommon = length common
 #ifdef mingw32_HOST_OS
-	normdrive = map toLower . takeWhile (/= ':') . fromRawFilePath . takeDrive
+	normdrive = map toLower
+		-- Get just the drive letter, removing any leading
+		-- path separator, which takeDrive leaves on the drive
+		-- letter.
+		. dropWhileEnd (isPathSeparator . fromIntegral . ord)
+		. fromRawFilePath 
+		. takeDrive
 #endif
 
 {- Checks if a command is available in PATH.
diff --git a/Utility/Tmp.hs b/Utility/Tmp.hs
index 5877f68..92bd921 100644
--- a/Utility/Tmp.hs
+++ b/Utility/Tmp.hs
@@ -14,6 +14,7 @@ module Utility.Tmp (
 	withTmpFile,
 	withTmpFileIn,
 	relatedTemplate,
+	openTmpFileIn,
 ) where
 
 import System.IO
@@ -21,6 +22,7 @@ import System.FilePath
 import System.Directory
 import Control.Monad.IO.Class
 import System.PosixCompat.Files hiding (removeLink)
+import System.IO.Error
 
 import Utility.Exception
 import Utility.FileSystemEncoding
@@ -28,6 +30,18 @@ import Utility.FileMode
 
 type Template = String
 
+{- This is the same as openTempFile, except when there is an
+ - error, it displays the template as well as the directory,
+ - to help identify what call was responsible.
+ -}
+openTmpFileIn :: FilePath -> String -> IO (FilePath, Handle)
+openTmpFileIn dir template = openTempFile dir template
+	`catchIO` decoraterrror
+  where
+	decoraterrror e = throwM $
+		let loc = ioeGetLocation e ++ " template " ++ template
+		in annotateIOError e loc Nothing Nothing
+
 {- Runs an action like writeFile, writing to a temp file first and
  - then moving it into place. The temp file is stored in the same
  - directory as the final file to avoid cross-device renames.
@@ -43,7 +57,7 @@ viaTmp a file content = bracketIO setup cleanup use
 	template = relatedTemplate (base ++ ".tmp")
 	setup = do
 		createDirectoryIfMissing True dir
-		openTempFile dir template
+		openTmpFileIn dir template
 	cleanup (tmpfile, h) = do
 		_ <- tryIO $ hClose h
 		tryIO $ removeFile tmpfile
@@ -73,7 +87,7 @@ withTmpFile template a = do
 withTmpFileIn :: (MonadIO m, MonadMask m) => FilePath -> Template -> (FilePath -> Handle -> m a) -> m a
 withTmpFileIn tmpdir template a = bracket create remove use
   where
-	create = liftIO $ openTempFile tmpdir template
+	create = liftIO $ openTmpFileIn tmpdir template
 	remove (name, h) = liftIO $ do
 		hClose h
 		catchBoolIO (removeFile name >> return True)
diff --git a/Utility/Tmp/Dir.hs b/Utility/Tmp/Dir.hs
index c68ef86..904b65a 100644
--- a/Utility/Tmp/Dir.hs
+++ b/Utility/Tmp/Dir.hs
@@ -1,6 +1,6 @@
 {- Temporary directories
  -
- - Copyright 2010-2013 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2022 Joey Hess <id@joeyh.name>
  -
  - License: BSD-2-clause
  -}
@@ -63,8 +63,10 @@ removeTmpDir tmpdir = liftIO $ whenM (doesDirectoryExist tmpdir) $ do
 	-- after a process has just written to it and exited.
 	-- Because it's crap, presumably. So, ignore failure
 	-- to delete the temp directory.
-	_ <- tryIO $ removeDirectoryRecursive tmpdir
+	_ <- tryIO $ go tmpdir
 	return ()
 #else
-	removeDirectoryRecursive tmpdir
+	go tmpdir
 #endif
+  where
+	go = removeDirectoryRecursive
diff --git a/git-repair.cabal b/git-repair.cabal
index ed3d68e..582821d 100644
--- a/git-repair.cabal
+++ b/git-repair.cabal
@@ -1,11 +1,11 @@
 Name: git-repair
-Version: 1.20210629
+Version: 1.20220404
 Cabal-Version: >= 1.10
 License: AGPL-3
 Maintainer: Joey Hess <joey@kitenet.net>
 Author: Joey Hess
 Stability: Stable
-Copyright: 2013-2021 Joey Hess
+Copyright: 2013-2022 Joey Hess
 License-File: COPYRIGHT
 Build-Type: Custom
 Homepage: http://git-repair.branchable.com/
@@ -26,9 +26,9 @@ Extra-Source-Files:
   git-repair.1
 
 custom-setup
-  Setup-Depends: base (>= 4.11.1.0 && < 5.0), 
+  Setup-Depends: base (>= 4.11.1.0), 
     hslogger, split, unix-compat, process, unix, filepath,
-    filepath-bytestring (>= 1.4.2.1.1), async,
+    filepath-bytestring (>= 1.4.2.1.4), async,
     exceptions, bytestring, directory, IfElse, data-default,
     mtl, Cabal, time
 
@@ -43,11 +43,11 @@ Executable git-repair
   Default-Extensions: LambdaCase
   Build-Depends: split, hslogger, directory, filepath, containers, mtl,
    unix-compat (>= 0.5), bytestring, exceptions (>= 0.6), transformers,
-   base (>= 4.11.1.0 && < 5.0), IfElse, text, process, time, QuickCheck,
+   base (>= 4.11.1.0), IfElse, text, process, time, QuickCheck,
    utf8-string, async, optparse-applicative (>= 0.14.1),
    data-default, deepseq, attoparsec,
    network-uri (>= 2.6), network (>= 2.6),
-   filepath-bytestring (>= 1.4.2.1.0),
+   filepath-bytestring (>= 1.4.2.1.4),
    time
 
   if (os(windows))