diff --git a/Build/TestConfig.hs b/Build/TestConfig.hs
--- a/Build/TestConfig.hs
+++ b/Build/TestConfig.hs
@@ -97,7 +97,7 @@
  - the command. -}
 findCmdPath :: ConfigKey -> String -> Test
 findCmdPath k command = do
-	ifM (inPath command)
+	ifM (inSearchPath command)
 		( return $ Config k $ MaybeStringConfig $ Just command
 		, do
 			r <- getM find ["/usr/sbin", "/sbin", "/usr/local/sbin"]
diff --git a/CHANGELOG b/CHANGELOG
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -1,3 +1,12 @@
+git-repair (1.20210629) unstable; urgency=medium
+
+  * Fixed bug that interrupting the program while it was fixing repository
+    corruption would lose objects that were contained in pack files.
+  * Fix reversion in version 1.20200504 that prevented fetching
+    missing objects from remotes.
+
+ -- Joey Hess <id@joeyh.name>  Tue, 29 Jun 2021 13:29:10 -0400
+
 git-repair (1.20210111) unstable; urgency=medium
 
   * Improve output to not give the impression it's stalled running fsck
diff --git a/Git.hs b/Git.hs
--- a/Git.hs
+++ b/Git.hs
@@ -3,7 +3,7 @@
  - This is written to be completely independant of git-annex and should be
  - suitable for other uses.
  -
- - Copyright 2010-2020 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2021 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -55,6 +55,7 @@
 repoDescribe :: Repo -> String
 repoDescribe Repo { remoteName = Just name } = name
 repoDescribe Repo { location = Url url } = show url
+repoDescribe Repo { location = UnparseableUrl url } = url
 repoDescribe Repo { location = Local { worktree = Just dir } } = fromRawFilePath dir
 repoDescribe Repo { location = Local { gitdir = dir } } = fromRawFilePath dir
 repoDescribe Repo { location = LocalUnknown dir } = fromRawFilePath dir
@@ -63,13 +64,14 @@
 {- Location of the repo, either as a path or url. -}
 repoLocation :: Repo -> String
 repoLocation Repo { location = Url url } = show url
+repoLocation Repo { location = UnparseableUrl url } = url
 repoLocation Repo { location = Local { worktree = Just dir } } = fromRawFilePath dir
 repoLocation Repo { location = Local { gitdir = dir } } = fromRawFilePath dir
 repoLocation Repo { location = LocalUnknown dir } = fromRawFilePath dir
 repoLocation Repo { location = Unknown } = error "unknown repoLocation"
 
 {- Path to a repository. For non-bare, this is the worktree, for bare, 
- - it's the gitdir, and for URL repositories, is the path on the remote
+ - it's the gitdit, and for URL repositories, is the path on the remote
  - host. -}
 repoPath :: Repo -> RawFilePath
 repoPath Repo { location = Url u } = toRawFilePath $ unEscapeString $ uriPath u
@@ -77,6 +79,7 @@
 repoPath Repo { location = Local { gitdir = d } } = d
 repoPath Repo { location = LocalUnknown dir } = dir
 repoPath Repo { location = Unknown } = error "unknown repoPath"
+repoPath Repo { location = UnparseableUrl _u } = error "unknwon repoPath"
 
 repoWorkTree :: Repo -> Maybe RawFilePath
 repoWorkTree Repo { location = Local { worktree = Just d } } = Just d
@@ -91,6 +94,7 @@
  - or bare and non-bare, these functions help with that. -}
 repoIsUrl :: Repo -> Bool
 repoIsUrl Repo { location = Url _ } = True
+repoIsUrl Repo { location = UnparseableUrl _ } = True
 repoIsUrl _ = False
 
 repoIsSsh :: Repo -> Bool
diff --git a/Git/Branch.hs b/Git/Branch.hs
--- a/Git/Branch.hs
+++ b/Git/Branch.hs
@@ -1,6 +1,6 @@
 {- git branch stuff
  -
- - Copyright 2011 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2021 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -166,7 +166,7 @@
  -}
 commit :: CommitMode -> Bool -> String -> Branch -> [Ref] -> Repo -> IO (Maybe Sha)
 commit commitmode allowempty message branch parentrefs repo = do
-	tree <- getSha "write-tree" $ pipeReadStrict [Param "write-tree"] repo
+	tree <- writeTree repo
 	ifM (cancommit tree)
 		( do
 			sha <- commitTree commitmode message parentrefs tree repo
@@ -184,6 +184,19 @@
 commitAlways :: CommitMode -> String -> Branch -> [Ref] -> Repo -> IO Sha
 commitAlways commitmode message branch parentrefs repo = fromJust
 	<$> commit commitmode True message branch parentrefs repo
+
+-- Throws exception if the index is locked, with an error message output by
+-- git on stderr.
+writeTree :: Repo -> IO Sha
+writeTree repo = getSha "write-tree" $
+	pipeReadStrict [Param "write-tree"] repo
+
+-- Avoids error output if the command fails due to eg, the index being locked.
+writeTreeQuiet :: Repo -> IO (Maybe Sha)
+writeTreeQuiet repo = extractSha <$> withNullHandle go
+  where
+	go nullh = pipeReadStrict' (\p -> p { std_err = UseHandle nullh }) 
+		[Param "write-tree"] repo
 
 commitTree :: CommitMode -> String -> [Ref] -> Ref -> Repo -> IO Sha
 commitTree commitmode message parentrefs tree repo =
diff --git a/Git/CatFile.hs b/Git/CatFile.hs
--- a/Git/CatFile.hs
+++ b/Git/CatFile.hs
@@ -326,7 +326,7 @@
 		(hClose hin)
 		(catObjectReader readObjectContent c hout)
 	feeder c h (v, ref) = do
-		liftIO $ writeChan c (ref, v)
+		writeChan c (ref, v)
 		S8.hPutStrLn h (fromRef' ref)
 
 catObjectMetaDataStream
diff --git a/Git/Command.hs b/Git/Command.hs
--- a/Git/Command.hs
+++ b/Git/Command.hs
@@ -70,17 +70,15 @@
  - Nonzero exit status is ignored.
  -}
 pipeReadStrict :: [CommandParam] -> Repo -> IO S.ByteString
-pipeReadStrict = pipeReadStrict' S.hGetContents
+pipeReadStrict = pipeReadStrict' id
 
-{- The reader action must be strict. -}
-pipeReadStrict' :: (Handle -> IO a) -> [CommandParam] -> Repo -> IO a
-pipeReadStrict' reader params repo = assertLocal repo $ withCreateProcess p go
+pipeReadStrict' :: (CreateProcess -> CreateProcess) -> [CommandParam] -> Repo -> IO S.ByteString
+pipeReadStrict' fp params repo = assertLocal repo $ withCreateProcess p go
   where
-	p  = (gitCreateProcess params repo)
-		{ std_out = CreatePipe }
+	p = fp (gitCreateProcess params repo) { std_out = CreatePipe }
 
 	go _ (Just outh) _ pid = do
-		output <- reader outh
+		output <- S.hGetContents outh
 		hClose outh
 		void $ waitForProcess pid
 		return output
diff --git a/Git/Construct.hs b/Git/Construct.hs
--- a/Git/Construct.hs
+++ b/Git/Construct.hs
@@ -1,6 +1,6 @@
 {- Construction of Git Repo objects
  -
- - Copyright 2010-2020 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2021 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -57,54 +57,58 @@
 
 {- Local Repo constructor, accepts a relative or absolute path. -}
 fromPath :: RawFilePath -> IO Repo
-fromPath dir = fromAbsPath =<< absPath dir
+fromPath dir
+	-- When dir == "foo/.git", git looks for "foo/.git/.git",
+	-- and failing that, uses "foo" as the repository.
+	| (P.pathSeparator `B.cons` ".git") `B.isSuffixOf` canondir =
+		ifM (doesDirectoryExist $ fromRawFilePath dir </> ".git")
+			( ret dir
+			, ret (P.takeDirectory canondir)
+			)
+	| otherwise = ifM (doesDirectoryExist (fromRawFilePath dir))
+		( checkGitDirFile dir >>= maybe (ret dir) (pure . newFrom)
+		-- git falls back to dir.git when dir doesn't
+		-- exist, as long as dir didn't end with a
+		-- path separator
+		, if dir == canondir
+			then ret (dir <> ".git")
+			else ret dir
+		)
+  where
+	ret = pure . newFrom . LocalUnknown
+	canondir = P.dropTrailingPathSeparator dir
 
 {- Local Repo constructor, requires an absolute path to the repo be
  - specified. -}
 fromAbsPath :: RawFilePath -> IO Repo
 fromAbsPath dir
-	| absoluteGitPath dir = hunt
+	| absoluteGitPath dir = fromPath dir
 	| otherwise =
 		error $ "internal error, " ++ show dir ++ " is not absolute"
-  where
-	ret = pure . newFrom . LocalUnknown
-	canondir = P.dropTrailingPathSeparator dir
-	{- When dir == "foo/.git", git looks for "foo/.git/.git",
-	 - and failing that, uses "foo" as the repository. -}
-	hunt
-		| (P.pathSeparator `B.cons` ".git") `B.isSuffixOf` canondir =
-			ifM (doesDirectoryExist $ fromRawFilePath dir </> ".git")
-				( ret dir
-				, ret (P.takeDirectory canondir)
-				)
-		| otherwise = ifM (doesDirectoryExist (fromRawFilePath dir))
-			( checkGitDirFile dir >>= maybe (ret dir) (pure . newFrom)
-			-- git falls back to dir.git when dir doesn't
-			-- exist, as long as dir didn't end with a
-			-- path separator
-			, if dir == canondir
-				then ret (dir <> ".git")
-				else ret dir
-			)
 
-{- Remote Repo constructor. Throws exception on invalid url.
+{- Construct a Repo for a remote's url.
  -
  - Git is somewhat forgiving about urls to repositories, allowing
- - eg spaces that are not normally allowed unescaped in urls.
+ - eg spaces that are not normally allowed unescaped in urls. Such
+ - characters get escaped.
+ -
+ - This will always succeed, even if the url cannot be parsed
+ - or is invalid, because git can also function despite remotes having
+ - such urls, only failing if such a remote is used.
  -}
 fromUrl :: String -> IO Repo
 fromUrl url
-	| not (isURI url) = fromUrlStrict $ escapeURIString isUnescapedInURI url
-	| otherwise = fromUrlStrict url
+	| not (isURI url) = fromUrl' $ escapeURIString isUnescapedInURI url
+	| otherwise = fromUrl' url
 
-fromUrlStrict :: String -> IO Repo
-fromUrlStrict url
-	| "file://" `isPrefixOf` url = fromAbsPath $ toRawFilePath $
-		unEscapeString $ uriPath u
-	| otherwise = pure $ newFrom $ Url u
-  where
-	u = fromMaybe bad $ parseURI url
-	bad = error $ "bad url " ++ url
+fromUrl' :: String -> IO Repo
+fromUrl' url
+	| "file://" `isPrefixOf` url = case parseURI url of
+		Just u -> fromAbsPath $ toRawFilePath $ unEscapeString $ uriPath u
+		Nothing -> pure $ newFrom $ UnparseableUrl url
+	| otherwise = case parseURI url of
+		Just u -> pure $ newFrom $ Url u
+		Nothing -> pure $ newFrom $ UnparseableUrl url
 
 {- Creates a repo that has an unknown location. -}
 fromUnknown :: Repo
@@ -116,24 +120,24 @@
 localToUrl reference r
 	| not $ repoIsUrl reference = error "internal error; reference repo not url"
 	| repoIsUrl r = r
-	| otherwise = case Url.authority reference of
-		Nothing -> r
-		Just auth -> 
+	| otherwise = case (Url.authority reference, Url.scheme reference) of
+		(Just auth, Just s) -> 
 			let absurl = concat
-				[ Url.scheme reference
+				[ s
 				, "//"
 				, auth
 				, fromRawFilePath (repoPath r)
 				]
 			in r { location = Url $ fromJust $ parseURI absurl }
+		_ -> r
 
 {- Calculates a list of a repo's configured remotes, by parsing its config. -}
 fromRemotes :: Repo -> IO [Repo]
-fromRemotes repo = mapM construct remotepairs
+fromRemotes repo = catMaybes <$> mapM construct remotepairs
   where
 	filterconfig f = filter f $ M.toList $ config repo
 	filterkeys f = filterconfig (\(k,_) -> f k)
-	remotepairs = filterkeys isRemoteKey
+	remotepairs = filterkeys isRemoteUrlKey
 	construct (k,v) = remoteNamedFromKey k $
 		fromRemoteLocation (fromConfigValue v) repo
 
@@ -145,8 +149,10 @@
 
 {- Sets the name of a remote based on the git config key, such as
  - "remote.foo.url". -}
-remoteNamedFromKey :: ConfigKey -> IO Repo -> IO Repo
-remoteNamedFromKey = remoteNamed . remoteKeyToRemoteName
+remoteNamedFromKey :: ConfigKey -> IO Repo -> IO (Maybe Repo)
+remoteNamedFromKey k r = case remoteKeyToRemoteName k of
+	Nothing -> pure Nothing
+	Just n -> Just <$> remoteNamed n r
 
 {- Constructs a new Repo for one of a Repo's remotes using a given
  - location (ie, an url). -}
@@ -187,6 +193,7 @@
 	expandt True ('~':'/':cs) = do
 		h <- myHomeDir
 		return $ h </> cs
+	expandt True "~" = myHomeDir
 	expandt True ('~':cs) = do
 		let (name, rest) = findname "" cs
 		u <- getUserEntryForName name
diff --git a/Git/CurrentRepo.hs b/Git/CurrentRepo.hs
--- a/Git/CurrentRepo.hs
+++ b/Git/CurrentRepo.hs
@@ -10,6 +10,7 @@
 module Git.CurrentRepo where
 
 import Common
+import Git
 import Git.Types
 import Git.Construct
 import qualified Git.Config
@@ -46,12 +47,12 @@
 	wt <- maybe (worktree (location r)) Just
 		<$> getpathenvprefix "GIT_WORK_TREE" prefix
 	case wt of
-		Nothing -> return r
+		Nothing -> relPath r
 		Just d -> do
 			curr <- R.getCurrentDirectory
 			unless (d `dirContains` curr) $
 				setCurrentDirectory (fromRawFilePath d)
-			return $ addworktree wt r
+			relPath $ addworktree wt r
   where
 	getpathenv s = do
 		v <- getEnv s
diff --git a/Git/Env.hs b/Git/Env.hs
new file mode 100644
--- /dev/null
+++ b/Git/Env.hs
@@ -0,0 +1,52 @@
+{- Adjusting the environment while running git commands.
+ -
+ - Copyright 2014-2016 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU AGPL version 3 or higher.
+ -}
+
+module Git.Env where
+
+import Common
+import Git
+import Git.Types
+import Utility.Env
+
+{- Adjusts the gitEnv of a Repo. Copies the system environment if the repo
+ - does not have any gitEnv yet. -}
+adjustGitEnv :: Repo -> ([(String, String)] -> [(String, String)]) -> IO Repo
+adjustGitEnv g adj = do
+	e <- maybe getEnvironment return (gitEnv g)
+	let e' = adj e
+	return $ g { gitEnv = Just e' }
+  where
+
+addGitEnv :: Repo -> String -> String -> IO Repo
+addGitEnv g var val = adjustGitEnv g (addEntry var val)
+
+{- Environment variables to use when running a command.
+ - Includes GIT_DIR pointing at the repo, and GIT_WORK_TREE when the repo
+ - is not bare. Also includes anything added to the Repo's gitEnv,
+ - and a copy of the rest of the system environment. -}
+propGitEnv :: Repo -> IO [(String, String)]
+propGitEnv g = do
+	g' <- addGitEnv g "GIT_DIR" (fromRawFilePath (localGitDir g))
+	g'' <- maybe (pure g')
+		(addGitEnv g' "GIT_WORK_TREE" . fromRawFilePath)
+		(repoWorkTree g)
+	return $ fromMaybe [] (gitEnv g'')
+
+{- Use with any action that makes a commit to set metadata. -}
+commitWithMetaData :: CommitMetaData -> CommitMetaData -> (Repo -> IO a) -> Repo -> IO a
+commitWithMetaData authormetadata committermetadata a g =
+	a =<< adjustGitEnv g adj
+  where
+	adj = mkadj "AUTHOR" authormetadata
+		. mkadj "COMMITTER" committermetadata
+	mkadj p md = go "NAME" commitName
+		. go "EMAIL" commitEmail
+		. go "DATE" commitDate
+	  where
+		go s getv = case getv md of
+			Nothing -> id
+			Just v -> addEntry ("GIT_" ++ p ++ "_" ++ s) v
diff --git a/Git/LsTree.hs b/Git/LsTree.hs
--- a/Git/LsTree.hs
+++ b/Git/LsTree.hs
@@ -1,13 +1,14 @@
 {- git ls-tree 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.
  -}
 
 module Git.LsTree (
 	TreeItem(..),
-	LsTreeMode(..),
+	LsTreeRecursive(..),
+	LsTreeLong(..),
 	lsTree,
 	lsTree',
 	lsTreeStrict,
@@ -27,6 +28,7 @@
 
 import Numeric
 import Data.Either
+import Data.Char
 import System.Posix.Types
 import qualified Data.ByteString as S
 import qualified Data.ByteString.Lazy as L
@@ -38,44 +40,55 @@
 	{ mode :: FileMode
 	, typeobj :: S.ByteString
 	, sha :: Ref
+	, size :: Maybe FileSize
 	, file :: TopFilePath
+	-- ^ only available when long is used
 	} deriving (Show)
 
-data LsTreeMode = LsTreeRecursive | LsTreeNonRecursive
+data LsTreeRecursive = LsTreeRecursive | LsTreeNonRecursive
 
+{- Enabling --long also gets the size of tree items.
+ - This slows down ls-tree some, since it has to look up the size of each
+ - blob.
+ -}
+data LsTreeLong = LsTreeLong Bool
+
 {- Lists the contents of a tree, with lazy output. -}
-lsTree :: LsTreeMode -> Ref -> Repo -> IO ([TreeItem], IO Bool)
+lsTree :: LsTreeRecursive -> LsTreeLong -> Ref -> Repo -> IO ([TreeItem], IO Bool)
 lsTree = lsTree' []
 
-lsTree' :: [CommandParam] -> LsTreeMode -> Ref -> Repo -> IO ([TreeItem], IO Bool)
-lsTree' ps lsmode t repo = do
-	(l, cleanup) <- pipeNullSplit (lsTreeParams lsmode t ps) repo
-	return (rights (map parseLsTree l), cleanup)
+lsTree' :: [CommandParam] -> LsTreeRecursive -> LsTreeLong -> Ref -> Repo -> IO ([TreeItem], IO Bool)
+lsTree' ps recursive long t repo = do
+	(l, cleanup) <- pipeNullSplit (lsTreeParams recursive long t ps) repo
+	return (rights (map (parseLsTree long) l), cleanup)
 
-lsTreeStrict :: LsTreeMode -> Ref -> Repo -> IO [TreeItem]
+lsTreeStrict :: LsTreeRecursive -> LsTreeLong -> Ref -> Repo -> IO [TreeItem]
 lsTreeStrict = lsTreeStrict' []
 
-lsTreeStrict' :: [CommandParam] -> LsTreeMode -> Ref -> Repo -> IO [TreeItem]
-lsTreeStrict' ps lsmode t repo = rights . map parseLsTreeStrict
-	<$> pipeNullSplitStrict (lsTreeParams lsmode t ps) repo
+lsTreeStrict' :: [CommandParam] -> LsTreeRecursive -> LsTreeLong -> Ref -> Repo -> IO [TreeItem]
+lsTreeStrict' ps recursive long t repo = rights . map (parseLsTreeStrict long)
+	<$> pipeNullSplitStrict (lsTreeParams recursive long t ps) repo
 
-lsTreeParams :: LsTreeMode -> Ref -> [CommandParam] -> [CommandParam]
-lsTreeParams lsmode r ps =
+lsTreeParams :: LsTreeRecursive -> LsTreeLong -> Ref -> [CommandParam] -> [CommandParam]
+lsTreeParams recursive long r ps =
 	[ Param "ls-tree"
 	, Param "--full-tree"
 	, Param "-z"
-	] ++ recursiveparams ++ ps ++
+	] ++ recursiveparams ++ longparams ++ ps ++
 	[ Param "--"
 	, File $ fromRef r
 	]
   where
-	recursiveparams = case lsmode of
+	recursiveparams = case recursive of
 		LsTreeRecursive -> [ Param "-r" ]
 		LsTreeNonRecursive -> []
+	longparams = case long of
+		LsTreeLong True -> [ Param "--long" ]
+		LsTreeLong False -> []
 
 {- Lists specified files in a tree. -}
-lsTreeFiles :: Ref -> [FilePath] -> Repo -> IO [TreeItem]
-lsTreeFiles t fs repo = rights . map (parseLsTree . L.fromStrict)
+lsTreeFiles :: LsTreeLong -> Ref -> [FilePath] -> Repo -> IO [TreeItem]
+lsTreeFiles long t fs repo = rights . map (parseLsTree long . L.fromStrict)
 	<$> pipeNullSplitStrict ps repo
   where
 	ps =
@@ -86,41 +99,57 @@
 		, File $ fromRef t
 		] ++ map File fs
 
-parseLsTree :: L.ByteString -> Either String TreeItem
-parseLsTree b = case A.parse parserLsTree b of
+parseLsTree :: LsTreeLong -> L.ByteString -> Either String TreeItem
+parseLsTree long b = case A.parse (parserLsTree long) b of
 	A.Done _ r  -> Right r
 	A.Fail _ _ err -> Left err
 
-parseLsTreeStrict :: S.ByteString -> Either String TreeItem
-parseLsTreeStrict b = go (AS.parse parserLsTree b)
+parseLsTreeStrict :: LsTreeLong -> S.ByteString -> Either String TreeItem
+parseLsTreeStrict long b = go (AS.parse (parserLsTree long) b)
   where
 	go (AS.Done _ r) = Right r
 	go (AS.Fail _ _ err) = Left err
 	go (AS.Partial c) = go (c mempty)
 
 {- Parses a line of ls-tree output, in format:
- - mode SP type SP sha TAB file
+ -   mode SP type SP sha TAB file
+ - Or long format:
+ -   mode SP type SP sha SPACES size TAB file
  -
- - (The --long format is not currently supported.) -}
-parserLsTree :: A.Parser TreeItem
-parserLsTree = TreeItem
-	-- mode
-	<$> octal
-	<* A8.char ' '
-	-- type
-	<*> A8.takeTill (== ' ')
-	<* A8.char ' '
-	-- sha
-	<*> (Ref <$> A8.takeTill (== '\t'))
-	<* A8.char '\t'
-	-- file
-	<*> (asTopFilePath . Git.Filename.decode <$> A.takeByteString)
+ - The TAB can also be a space. Git does not use that, but an earlier
+ - version of formatLsTree did, and this keeps parsing what it output
+ - working.
+ -}
+parserLsTree :: LsTreeLong -> A.Parser TreeItem
+parserLsTree long = case long of
+	LsTreeLong False -> 
+		startparser <*> pure Nothing <* filesep <*> fileparser
+	LsTreeLong True ->
+		startparser <* sizesep <*> sizeparser <* filesep <*> fileparser
+  where
+	startparser = TreeItem
+		-- mode
+		<$> octal
+		<* A8.char ' '
+		-- type
+		<*> A8.takeTill (== ' ')
+		<* A8.char ' '
+		-- sha
+		<*> (Ref <$> A8.takeTill A8.isSpace)
 
-{- Inverse of parseLsTree -}
-formatLsTree :: TreeItem -> String
-formatLsTree ti = unwords
-	[ showOct (mode ti) ""
-	, decodeBS (typeobj ti)
-	, fromRef (sha ti)
-	, fromRawFilePath (getTopFilePath (file ti))
-	]
+	fileparser = asTopFilePath . Git.Filename.decode <$> A.takeByteString
+
+	sizeparser = fmap Just A8.decimal
+
+	filesep = A8.space
+
+	sizesep = A.many1 A8.space
+
+{- Inverse of parseLsTree. Note that the long output format is not
+ - generated, so any size information is not included. -}
+formatLsTree :: TreeItem -> S.ByteString
+formatLsTree ti = S.intercalate (S.singleton (fromIntegral (ord ' ')))
+	[ 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
--- a/Git/Ref.hs
+++ b/Git/Ref.hs
@@ -64,12 +64,17 @@
 
 {- A Ref that can be used to refer to a file in the repository, as staged
  - in the index.
- -
- - Prefixing the file with ./ makes this work even if in a subdirectory
- - of a repo.
  -}
-fileRef :: RawFilePath -> Ref
-fileRef f = Ref $ ":./" <> toInternalGitPath f
+fileRef :: RawFilePath -> IO Ref
+fileRef f = 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'
 
 {- A Ref that can be used to refer to a file in a particular branch. -}
 branchFileRef :: Branch -> RawFilePath -> Ref
@@ -81,10 +86,13 @@
 
 {- A Ref that can be used to refer to a file in the repository as it
  - appears in a given Ref. -}
-fileFromRef :: Ref -> RawFilePath -> Ref
-fileFromRef r f = let (Ref fr) = fileRef f in Ref (fromRef' r <> fr)
+fileFromRef :: Ref -> RawFilePath -> IO Ref
+fileFromRef r f = do
+	(Ref fr) <- fileRef f
+	return (Ref (fromRef' r <> fr))
 
-{- Checks if a ref exists. -}
+{- Checks if a ref exists. Note that it must be fully qualified,
+ - eg refs/heads/master rather than master. -}
 exists :: Ref -> Repo -> IO Bool
 exists ref = runBool
 	[ Param "show-ref"
diff --git a/Git/Remote.hs b/Git/Remote.hs
--- a/Git/Remote.hs
+++ b/Git/Remote.hs
@@ -1,6 +1,6 @@
 {- git remote stuff
  -
- - Copyright 2012 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2021 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -23,15 +23,23 @@
 import Git.FilePath
 #endif
 
-{- Is a git config key one that specifies the location of a remote? -}
-isRemoteKey :: ConfigKey -> Bool
-isRemoteKey (ConfigKey k) = "remote." `S.isPrefixOf` k && ".url" `S.isSuffixOf` k
+{- Is a git config key one that specifies the url of a remote? -}
+isRemoteUrlKey :: ConfigKey -> Bool
+isRemoteUrlKey = isRemoteKey "url"
 
-{- Get a remote's name from the config key that specifies its location. -}
-remoteKeyToRemoteName :: ConfigKey -> RemoteName
-remoteKeyToRemoteName (ConfigKey k) = decodeBS' $
-	S.intercalate "." $ dropFromEnd 1 $ drop 1 $ S8.split '.' k
+isRemoteKey :: S.ByteString -> ConfigKey -> Bool
+isRemoteKey want (ConfigKey k) =
+	"remote." `S.isPrefixOf` k && ("." <> want) `S.isSuffixOf` k
 
+{- Get a remote's name from the a config key such as remote.name.url
+ - or any other per-remote config key. -}
+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)
+	| otherwise = Nothing
+
 {- Construct a legal git remote name out of an arbitrary input string.
  -
  - There seems to be no formal definition of this in the git source,
@@ -99,7 +107,9 @@
 			concatMap splitconfigs $ M.toList $ fullconfig repo
 		splitconfigs (k, vs) = map (\v -> (k, v)) vs
 		(prefix, suffix) = ("url." , ".insteadof")
-	urlstyle v = isURI v || ":" `isInfixOf` v && "//" `isInfixOf` v
+	-- git supports URIs that contain unescaped characters such as
+	-- spaces. So to test if it's a (git) URI, escape those.
+	urlstyle v = isURI (escapeURIString isUnescapedInURI v)
 	-- git remotes can be written scp style -- [user@]host:dir
 	-- but foo::bar is a git-remote-helper location instead
 	scpstyle v = ":" `isInfixOf` v 
diff --git a/Git/Repair.hs b/Git/Repair.hs
--- a/Git/Repair.hs
+++ b/Git/Repair.hs
@@ -1,6 +1,6 @@
 {- git repository recovery
  -
- - Copyright 2013-2014 Joey Hess <id@joeyh.name>
+ - Copyright 2013-2021 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -29,6 +29,7 @@
 import Git.Types
 import Git.Fsck
 import Git.Index
+import Git.Env
 import qualified Git.Config as Config
 import qualified Git.Construct as Construct
 import qualified Git.LsTree as LsTree
@@ -61,15 +62,14 @@
 		whenM (isMissing s r) $
 			removeLoose s
 
-{- Explodes all pack files, and deletes them.
- -
- - First moves all pack files to a temp dir, before unpacking them each in
- - turn.
+{- Explodes all pack files to loose objects, and deletes the pack files.
  -
- - This is because unpack-objects will not unpack a pack file if it's in the
- - git repo.
+ - git unpack-objects will not unpack objects from a pack file that are
+ - in the git repo. So, GIT_OBJECT_DIRECTORY is pointed to a temporary
+ - directory, and the loose objects then are moved into place, before
+ - deleting the pack files.
  -
- - Also, this prevents unpack-objects from possibly looking at corrupt
+ - Also, that prevents unpack-objects from possibly looking at corrupt
  - pack files to see if they contain an object, while unpacking a
  - non-corrupt pack file.
  -}
@@ -78,18 +78,28 @@
   where
 	go [] = return False
 	go packs = withTmpDir "packs" $ \tmpdir -> do
+		r' <- addGitEnv r "GIT_OBJECT_DIRECTORY" tmpdir
 		putStrLn "Unpacking all pack files."
 		forM_ packs $ \packfile -> do
-			moveFile packfile (tmpdir </> takeFileName packfile)
-			removeWhenExistsWith R.removeLink
-				(packIdxFile (toRawFilePath packfile))
-		forM_ packs $ \packfile -> do
-			let tmp = tmpdir </> takeFileName packfile
-			allowRead (toRawFilePath tmp)
+			-- Just in case permissions are messed up.
+			allowRead (toRawFilePath packfile)
 			-- May fail, if pack file is corrupt.
 			void $ tryIO $
-				pipeWrite [Param "unpack-objects", Param "-r"] r $ \h ->
-				L.hPut h =<< L.readFile tmp
+				pipeWrite [Param "unpack-objects", Param "-r"] r' $ \h ->
+				L.hPut h =<< L.readFile packfile
+		objs <- dirContentsRecursive tmpdir
+		forM_ objs $ \objfile -> do
+			f <- relPathDirToFile
+				(toRawFilePath tmpdir)
+				(toRawFilePath objfile)
+			let dest = objectsDir r P.</> f
+			createDirectoryIfMissing True
+				(fromRawFilePath (parentDir dest))
+			moveFile objfile (fromRawFilePath dest)
+		forM_ packs $ \packfile -> do
+			let f = toRawFilePath packfile
+			removeWhenExistsWith R.removeLink f
+			removeWhenExistsWith R.removeLink (packIdxFile f)
 		return True
 
 {- Try to retrieve a set of missing objects, from the remotes of a
@@ -105,7 +115,10 @@
 	| otherwise = withTmpDir "tmprepo" $ \tmpdir -> do
 		unlessM (boolSystem "git" [Param "init", File tmpdir]) $
 			error $ "failed to create temp repository in " ++ tmpdir
-		tmpr <- Config.read =<< Construct.fromAbsPath (toRawFilePath tmpdir)
+		tmpr <- Config.read =<< Construct.fromPath (toRawFilePath tmpdir)
+		let repoconfig r' = fromRawFilePath (localGitDir r' P.</> "config")
+		whenM (doesFileExist (repoconfig r)) $
+			L.readFile (repoconfig r) >>= L.writeFile (repoconfig tmpr)
 		rs <- Construct.fromRemotes r
 		stillmissing <- pullremotes tmpr rs fetchrefstags missing
 		if S.null (knownMissing stillmissing)
@@ -351,8 +364,9 @@
 verifyTree missing treesha r
 	| S.member treesha missing = return False
 	| otherwise = do
-		(ls, cleanup) <- pipeNullSplit (LsTree.lsTreeParams LsTree.LsTreeRecursive treesha []) r
-		let objshas = mapMaybe (LsTree.sha <$$> eitherToMaybe . LsTree.parseLsTree) ls
+		let nolong = LsTree.LsTreeLong False
+		(ls, cleanup) <- pipeNullSplit (LsTree.lsTreeParams LsTree.LsTreeRecursive nolong treesha []) r
+		let objshas = mapMaybe (LsTree.sha <$$> eitherToMaybe . LsTree.parseLsTree nolong) ls
 		if any (`S.member` missing) objshas
 			then do
 				void cleanup
diff --git a/Git/Types.hs b/Git/Types.hs
--- a/Git/Types.hs
+++ b/Git/Types.hs
@@ -34,6 +34,7 @@
 	= Local { gitdir :: RawFilePath, worktree :: Maybe RawFilePath }
 	| LocalUnknown RawFilePath
 	| Url URI
+	| UnparseableUrl String
 	| Unknown
 	deriving (Show, Eq, Ord)
 
diff --git a/Git/Url.hs b/Git/Url.hs
--- a/Git/Url.hs
+++ b/Git/Url.hs
@@ -1,6 +1,6 @@
 {- git repository urls
  -
- - Copyright 2010, 2011 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2021 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -18,12 +18,11 @@
 
 import Common
 import Git.Types
-import Git
 
 {- Scheme of an URL repo. -}
-scheme :: Repo -> String
-scheme Repo { location = Url u } = uriScheme u
-scheme repo = notUrl repo
+scheme :: Repo -> Maybe String
+scheme Repo { location = Url u } = Just (uriScheme u)
+scheme _ = Nothing
 
 {- Work around a bug in the real uriRegName
  - <http://trac.haskell.org/network/ticket/40> -}
@@ -65,13 +64,9 @@
 {- Applies a function to extract part of the uriAuthority of an URL repo. -}
 authpart :: (URIAuth -> a) -> Repo -> Maybe a
 authpart a Repo { location = Url u } = a <$> uriAuthority u
-authpart _ repo = notUrl repo
+authpart _ _ = Nothing
 
 {- Path part of an URL repo. -}
-path :: Repo -> FilePath
-path Repo { location = Url u } = uriPath u
-path repo = notUrl repo
-
-notUrl :: Repo -> a
-notUrl repo = error $
-	"acting on local git repo " ++ repoDescribe repo ++ " not supported"
+path :: Repo -> Maybe FilePath
+path Repo { location = Url u } = Just (uriPath u)
+path _ = Nothing
diff --git a/Utility/Batch.hs b/Utility/Batch.hs
--- a/Utility/Batch.hs
+++ b/Utility/Batch.hs
@@ -57,7 +57,7 @@
 getBatchCommandMaker :: IO BatchCommandMaker
 getBatchCommandMaker = do
 #ifndef mingw32_HOST_OS
-	nicers <- filterM (inPath . fst)
+	nicers <- filterM (inSearchPath . fst)
 		[ ("nice", [])
 		, ("ionice", ["-c3"])
 		, ("nocache", [])
diff --git a/Utility/Debug.hs b/Utility/Debug.hs
new file mode 100644
--- /dev/null
+++ b/Utility/Debug.hs
@@ -0,0 +1,102 @@
+{- Debug output
+ -
+ - Copyright 2021 Joey Hess <id@joeyh.name>
+ -
+ - License: BSD-2-clause
+ -}
+
+{-# LANGUAGE OverloadedStrings, FlexibleInstances, TypeSynonymInstances #-}
+{-# LANGUAGE LambdaCase #-}
+{-# OPTIONS_GHC -fno-warn-tabs -w #-}
+
+module Utility.Debug (
+	DebugSource(..),
+	DebugSelector(..),
+	configureDebug,
+	getDebugSelector,
+	debug,
+	fastDebug
+) where
+
+import qualified Data.ByteString as S
+import Data.IORef
+import Data.String
+import Data.Time
+import System.IO.Unsafe (unsafePerformIO)
+import qualified Data.Semigroup as Sem
+import Prelude
+
+import Utility.FileSystemEncoding
+
+-- | The source of a debug message. For example, this could be a module or
+-- function name.
+newtype DebugSource = DebugSource S.ByteString
+	deriving (Eq, Show)
+
+instance IsString DebugSource where
+	fromString = DebugSource . encodeBS'
+
+-- | Selects whether to display a message from a source.
+data DebugSelector 
+	= DebugSelector (DebugSource -> Bool)
+	| NoDebugSelector
+
+instance Sem.Semigroup DebugSelector where
+	DebugSelector a <> DebugSelector b = DebugSelector (\v -> a v || b v)
+	NoDebugSelector <> NoDebugSelector = NoDebugSelector
+	NoDebugSelector <> b = b
+	a <> NoDebugSelector = a
+
+instance Monoid DebugSelector where
+	mempty = NoDebugSelector
+
+-- | Configures debugging.
+configureDebug
+	:: (S.ByteString -> IO ())
+	-- ^ Used to display debug output.
+	-> DebugSelector
+	-> IO ()
+configureDebug src p = writeIORef debugConfigGlobal (src, p)
+
+-- | Gets the currently configured DebugSelector.
+getDebugSelector :: IO DebugSelector
+getDebugSelector = snd <$> readIORef debugConfigGlobal
+
+-- A global variable for the debug configuration.
+{-# NOINLINE debugConfigGlobal #-}
+debugConfigGlobal :: IORef (S.ByteString -> IO (), DebugSelector)
+debugConfigGlobal = unsafePerformIO $ newIORef (dontshow, selectnone)
+  where
+	dontshow _ = return ()
+	selectnone = NoDebugSelector
+
+-- | Displays a debug message, if that has been enabled by configureDebug.
+--
+-- This is reasonably fast when debugging is not enabled, but since it does
+-- have to consult a IORef each time, using it in a tight loop may slow
+-- down the program.
+debug :: DebugSource -> String -> IO ()
+debug src msg = readIORef debugConfigGlobal >>= \case
+	(displayer, NoDebugSelector) ->
+		displayer =<< formatDebugMessage src msg
+	(displayer, DebugSelector p)
+		| p src -> displayer =<< formatDebugMessage src msg
+		| otherwise -> return ()
+
+-- | Displays a debug message, if the DebugSelector allows.
+--
+-- When the DebugSelector does not let the message be displayed, this runs
+-- very quickly, allowing it to be used inside tight loops.
+fastDebug :: DebugSelector -> DebugSource -> String -> IO ()
+fastDebug NoDebugSelector src msg = do
+	(displayer, _) <- readIORef debugConfigGlobal
+	displayer =<< formatDebugMessage src msg
+fastDebug (DebugSelector p) src msg
+	| p src = fastDebug NoDebugSelector src msg
+	| otherwise = return ()
+
+formatDebugMessage :: DebugSource -> String -> IO S.ByteString
+formatDebugMessage (DebugSource src) msg = do
+	t <- encodeBS' . formatTime defaultTimeLocale "[%F %X%Q]"
+		<$> getZonedTime
+	return (t <> " (" <> src <> ") " <> encodeBS msg)
diff --git a/Utility/Exception.hs b/Utility/Exception.hs
--- a/Utility/Exception.hs
+++ b/Utility/Exception.hs
@@ -39,7 +39,7 @@
 
 {- Like error, this throws an exception. Unlike error, if this exception
  - is not caught, it won't generate a backtrace. So use this for situations
- - where there's a problem that the user is expeected to see in some
+ - where there's a problem that the user is expected to see in some
  - circumstances. -}
 giveup :: [Char] -> a
 giveup = errorWithoutStackTrace
diff --git a/Utility/InodeCache.hs b/Utility/InodeCache.hs
--- a/Utility/InodeCache.hs
+++ b/Utility/InodeCache.hs
@@ -24,6 +24,7 @@
 	showInodeCache,
 	genInodeCache,
 	toInodeCache,
+	toInodeCache',
 
 	InodeCacheKey,
 	inodeCacheToKey,
@@ -189,7 +190,10 @@
 	toInodeCache delta f =<< R.getFileStatus f
 
 toInodeCache :: TSDelta -> RawFilePath -> FileStatus -> IO (Maybe InodeCache)
-toInodeCache (TSDelta getdelta) f s
+toInodeCache d f s = toInodeCache' d f s (fileID s)
+
+toInodeCache' :: TSDelta -> RawFilePath -> FileStatus -> FileID -> IO (Maybe InodeCache)
+toInodeCache' (TSDelta getdelta) f s inode
 	| isRegularFile s = do
 		delta <- getdelta
 		sz <- getFileSize' f s
@@ -198,7 +202,7 @@
 #else
 		let mtime = modificationTimeHiRes s
 #endif
-		return $ Just $ InodeCache $ InodeCachePrim (fileID s) sz (MTimeHighRes (mtime + highResTime delta))
+		return $ Just $ InodeCache $ InodeCachePrim inode sz (MTimeHighRes (mtime + highResTime delta))
 	| otherwise = pure Nothing
 
 {- Some filesystem get new random inodes each time they are mounted.
diff --git a/Utility/Metered.hs b/Utility/Metered.hs
--- a/Utility/Metered.hs
+++ b/Utility/Metered.hs
@@ -1,6 +1,6 @@
 {- Metered IO and actions
  -
- - Copyright 2012-2020 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2021 Joey Hess <id@joeyh.name>
  -
  - License: BSD-2-clause
  -}
@@ -118,23 +118,24 @@
 withMeteredFile f meterupdate a = withBinaryFile f ReadMode $ \h ->
 	hGetContentsMetered h meterupdate >>= a
 
-{- Writes a ByteString to a Handle, updating a meter as it's written. -}
-meteredWrite :: MeterUpdate -> Handle -> L.ByteString -> IO ()
-meteredWrite meterupdate h = void . meteredWrite' meterupdate h
+{- Calls the action repeatedly with chunks from the lazy ByteString.
+ - Updates the meter after each chunk is processed. -}
+meteredWrite :: MeterUpdate -> (S.ByteString -> IO ()) -> L.ByteString -> IO ()
+meteredWrite meterupdate a = void . meteredWrite' meterupdate a
 
-meteredWrite' :: MeterUpdate -> Handle -> L.ByteString -> IO BytesProcessed
-meteredWrite' meterupdate h = go zeroBytesProcessed . L.toChunks 
+meteredWrite' :: MeterUpdate -> (S.ByteString -> IO ()) -> L.ByteString -> IO BytesProcessed
+meteredWrite' meterupdate a = go zeroBytesProcessed . L.toChunks 
   where
 	go sofar [] = return sofar
 	go sofar (c:cs) = do
-		S.hPut h c
+		a c
 		let !sofar' = addBytesProcessed sofar $ S.length c
 		meterupdate sofar'
 		go sofar' cs
 
 meteredWriteFile :: MeterUpdate -> FilePath -> L.ByteString -> IO ()
 meteredWriteFile meterupdate f b = withBinaryFile f WriteMode $ \h ->
-	meteredWrite meterupdate h b
+	meteredWrite meterupdate (S.hPut h) b
 
 {- Applies an offset to a MeterUpdate. This can be useful when
  - performing a sequence of actions, such as multiple meteredWriteFiles,
@@ -424,7 +425,8 @@
 		hPutStr h ('\r':s ++ padding)
 		hFlush h
 
--- | Clear meter displayed by displayMeterHandle.
+-- | Clear meter displayed by displayMeterHandle. May be called before
+-- outputting something else, followed by more calls to displayMeterHandle.
 clearMeterHandle :: Meter -> Handle -> IO ()
 clearMeterHandle (Meter _ _ v _) h = do
 	olds <- readMVar v
diff --git a/Utility/Path.hs b/Utility/Path.hs
--- a/Utility/Path.hs
+++ b/Utility/Path.hs
@@ -18,11 +18,12 @@
 	segmentPaths',
 	runSegmentPaths,
 	runSegmentPaths',
-	inPath,
-	searchPath,
 	dotfile,
 	splitShortExtensions,
 	relPathDirToFileAbs,
+	inSearchPath,
+	searchPath,
+	searchPathContents,
 ) where
 
 import System.FilePath.ByteString
@@ -30,11 +31,13 @@
 import qualified Data.ByteString as B
 import Data.List
 import Data.Maybe
+import Control.Monad
 import Control.Applicative
 import Prelude
 
 import Utility.Monad
 import Utility.SystemDirectory
+import Utility.Exception
 
 #ifdef mingw32_HOST_OS
 import Data.Char
@@ -136,33 +139,6 @@
 runSegmentPaths' :: (Maybe RawFilePath -> a -> r) -> (a -> RawFilePath) -> ([RawFilePath] -> IO [a]) -> [RawFilePath] -> IO [[r]]
 runSegmentPaths' si c a paths = segmentPaths' si c paths <$> a paths
 
-{- Checks if a command is available in PATH.
- -
- - The command may be fully-qualified, in which case, this succeeds as
- - long as it exists. -}
-inPath :: String -> IO Bool
-inPath command = isJust <$> searchPath command
-
-{- Finds a command in PATH and returns the full path to it.
- -
- - The command may be fully qualified already, in which case it will
- - be returned if it exists.
- -
- - Note that this will find commands in PATH that are not executable.
- -}
-searchPath :: String -> IO (Maybe FilePath)
-searchPath command
-	| P.isAbsolute command = check command
-	| otherwise = P.getSearchPath >>= getM indir
-  where
-	indir d = check $ d P.</> command
-	check f = firstM doesFileExist
-#ifdef mingw32_HOST_OS
-		[f, f ++ ".exe"]
-#else
-		[f]
-#endif
-
 {- Checks if a filename is a unix dotfile. All files inside dotdirs
  - count as dotfiles. -}
 dotfile :: RawFilePath -> Bool
@@ -189,8 +165,7 @@
 		(base, ext) = splitExtension f
 		len = B.length ext
 
-{- This requires the first path to be absolute, and the
- - second path cannot contain ../ or ./
+{- This requires both paths to be absolute and normalized.
  -
  - On Windows, if the paths are on different drives,
  - a relative path is not possible and the path is simply
@@ -214,3 +189,44 @@
 #ifdef mingw32_HOST_OS
 	normdrive = map toLower . takeWhile (/= ':') . fromRawFilePath . takeDrive
 #endif
+
+{- Checks if a command is available in PATH.
+ -
+ - The command may be fully-qualified, in which case, this succeeds as
+ - long as it exists. -}
+inSearchPath :: String -> IO Bool
+inSearchPath command = isJust <$> searchPath command
+
+{- Finds a command in PATH and returns the full path to it.
+ -
+ - The command may be fully qualified already, in which case it will
+ - be returned if it exists.
+ -
+ - Note that this will find commands in PATH that are not executable.
+ -}
+searchPath :: String -> IO (Maybe FilePath)
+searchPath command
+	| P.isAbsolute command = check command
+	| otherwise = P.getSearchPath >>= getM indir
+  where
+	indir d = check $ d P.</> command
+	check f = firstM doesFileExist
+#ifdef mingw32_HOST_OS
+		[f, f ++ ".exe"]
+#else
+		[f]
+#endif
+
+{- Finds commands in PATH that match a predicate. Note that the predicate
+ - matches on the basename of the command, but the full path to it is
+ - returned.
+ -
+ - Note that this will find commands in PATH that are not executable.
+ -}
+searchPathContents :: (FilePath -> Bool) -> IO [FilePath]
+searchPathContents p =
+	filterM doesFileExist 
+		=<< (concat <$> (P.getSearchPath >>= mapM go))
+  where
+	go d = map (d P.</>) . filter p
+		<$> catchDefaultIO [] (getDirectoryContents d)
diff --git a/Utility/Path/AbsRel.hs b/Utility/Path/AbsRel.hs
--- a/Utility/Path/AbsRel.hs
+++ b/Utility/Path/AbsRel.hs
@@ -1,6 +1,6 @@
 {- absolute and relative path manipulation
  -
- - Copyright 2010-2020 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2021 Joey Hess <id@joeyh.name>
  -
  - License: BSD-2-clause
  -}
@@ -19,6 +19,7 @@
 ) where
 
 import System.FilePath.ByteString
+import qualified Data.ByteString as B
 #ifdef mingw32_HOST_OS
 import System.Directory (getCurrentDirectory)
 #else
@@ -64,22 +65,27 @@
 #endif
 		return $ absPathFrom cwd file
 
-{- Constructs a relative path from the CWD to a file.
+{- Constructs the minimal relative path from the CWD to a file.
  -
  - For example, assuming CWD is /tmp/foo/bar:
  -    relPathCwdToFile "/tmp/foo" == ".."
  -    relPathCwdToFile "/tmp/foo/bar" == "" 
+ -    relPathCwdToFile "../bar/baz" == "baz"
  -}
 relPathCwdToFile :: RawFilePath -> IO RawFilePath
-relPathCwdToFile f = do
+relPathCwdToFile f
+	-- Optimisation: Avoid doing any IO when the path is relative
+	-- and does not contain any ".." component.
+	| isRelative f && not (".." `B.isInfixOf` f) = return f
+	| otherwise = do
 #ifdef mingw32_HOST_OS
-	c <- toRawFilePath <$> getCurrentDirectory
+		c <- toRawFilePath <$> getCurrentDirectory
 #else
-	c <- getWorkingDirectory
+		c <- getWorkingDirectory
 #endif
-	relPathDirToFile c f
+		relPathDirToFile c f
 
-{- Constructs a relative path from a directory to a file. -}
+{- Constructs a minimal relative path from a directory to a file. -}
 relPathDirToFile :: RawFilePath -> RawFilePath -> IO RawFilePath
 relPathDirToFile from to = relPathDirToFileAbs <$> absPath from <*> absPath to
 
diff --git a/Utility/Process.hs b/Utility/Process.hs
--- a/Utility/Process.hs
+++ b/Utility/Process.hs
@@ -7,6 +7,7 @@
  -}
 
 {-# LANGUAGE CPP, Rank2Types, LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# OPTIONS_GHC -fno-warn-tabs #-}
 
 module Utility.Process (
@@ -38,10 +39,10 @@
 import Utility.Misc
 import Utility.Exception
 import Utility.Monad
+import Utility.Debug
 
 import System.Exit
 import System.IO
-import System.Log.Logger
 import Control.Monad.IO.Class
 import Control.Concurrent.Async
 import qualified Data.ByteString as S
@@ -187,7 +188,7 @@
 debugProcess :: CreateProcess -> ProcessHandle -> IO ()
 debugProcess p h = do
 	pid <- getPid h
-	debugM "Utility.Process" $ unwords
+	debug "Utility.Process" $ unwords
 		[ describePid pid
 		, action ++ ":"
 		, showCmd p
@@ -211,7 +212,7 @@
 	-- Have to get pid before waiting, which closes the ProcessHandle.
 	pid <- getPid h
 	r <- Utility.Process.Shim.waitForProcess h
-	debugM "Utility.Process" (describePid pid ++ " done " ++ show r)
+	debug "Utility.Process" (describePid pid ++ " done " ++ show r)
 	return r
 
 cleanupProcess :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO () 
diff --git a/Utility/QuickCheck.hs b/Utility/QuickCheck.hs
--- a/Utility/QuickCheck.hs
+++ b/Utility/QuickCheck.hs
@@ -12,8 +12,7 @@
 	( module X
 	, TestableString
 	, fromTestableString
-	, TestableFilePath
-	, fromTestableFilePath
+	, TestableFilePath(..)
 	, nonNegative
 	, positive
 	) where
diff --git a/Utility/ThreadScheduler.hs b/Utility/ThreadScheduler.hs
--- a/Utility/ThreadScheduler.hs
+++ b/Utility/ThreadScheduler.hs
@@ -15,6 +15,7 @@
 	threadDelaySeconds,
 	waitForTermination,
 	oneSecond,
+	unboundDelay,
 ) where
 
 import Control.Monad
diff --git a/git-repair.cabal b/git-repair.cabal
--- a/git-repair.cabal
+++ b/git-repair.cabal
@@ -1,11 +1,11 @@
 Name: git-repair
-Version: 1.20210111
+Version: 1.20210629
 Cabal-Version: >= 1.10
 License: AGPL-3
 Maintainer: Joey Hess <joey@kitenet.net>
 Author: Joey Hess
 Stability: Stable
-Copyright: 2013-2020 Joey Hess
+Copyright: 2013-2021 Joey Hess
 License-File: COPYRIGHT
 Build-Type: Custom
 Homepage: http://git-repair.branchable.com/
@@ -30,7 +30,7 @@
     hslogger, split, unix-compat, process, unix, filepath,
     filepath-bytestring (>= 1.4.2.1.1), async,
     exceptions, bytestring, directory, IfElse, data-default,
-    mtl, Cabal
+    mtl, Cabal, time
 
 source-repository head
   type: git
@@ -47,7 +47,8 @@
    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.0),
+   time
 
   if (os(windows))
     Build-Depends: setenv
@@ -70,6 +71,7 @@
     Git.CurrentRepo
     Git.Destroyer
     Git.DiffTreeItem
+    Git.Env
     Git.FilePath
     Git.Filename
     Git.Fsck
@@ -91,6 +93,7 @@
     Utility.Applicative
     Utility.Batch
     Utility.CoProcess
+    Utility.Debug
     Utility.Data
     Utility.DataUnits
     Utility.Directory