merge from git-annex

Support building with unix-compat 0.7

16 files changed, 323 insertions, 145 deletions

diff --git a/Git/CatFile.hs b/Git/CatFile.hs
index f33ad49..daa41ad 100644
--- a/Git/CatFile.hs
+++ b/Git/CatFile.hs
@@ -120,7 +120,7 @@ catObjectDetails h object = query (catFileProcess h) object newlinefallback $ \f
 			content <- readObjectContent from r
 			return $ Just (content, sha, objtype)
 		Just DNE -> return Nothing
-		Nothing -> error $ "unknown response from git cat-file " ++ show (header, object)
+		Nothing -> giveup $ "unknown response from git cat-file " ++ show (header, object)
   where
 	-- Slow fallback path for filenames containing newlines.
 	newlinefallback = queryObjectType object (catFileGitRepo h) >>= \case
@@ -144,7 +144,7 @@ readObjectContent h (ParsedResp _ _ size) = do
 	eatchar expected = do
 		c <- hGetChar h
 		when (c /= expected) $
-			error $ "missing " ++ (show expected) ++ " from git cat-file"
+			giveup $ "missing " ++ (show expected) ++ " from git cat-file"
 readObjectContent _ DNE = error "internal"
 
 {- Gets the size and type of an object, without reading its content. -}
diff --git a/Git/Config.hs b/Git/Config.hs
index 5deba6b..4ff3454 100644
--- a/Git/Config.hs
+++ b/Git/Config.hs
@@ -1,6 +1,6 @@
 {- git repository configuration handling
  -
- - Copyright 2010-2020 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2022 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -22,6 +22,8 @@ import Git.Types
 import qualified Git.Command
 import qualified Git.Construct
 import Utility.UserInfo
+import Utility.Process.Transcript
+import Utility.Debug
 
 {- Returns a single git config setting, or a fallback value if not set. -}
 get :: ConfigKey -> ConfigValue -> Repo -> ConfigValue
@@ -55,12 +57,22 @@ reRead r = read' $ r
 read' :: Repo -> IO Repo
 read' repo = go repo
   where
-	go Repo { location = Local { gitdir = d } } = git_config d
-	go Repo { location = LocalUnknown d } = git_config d
+	-- Passing --git-dir changes git's behavior when run in a
+	-- repository belonging to another user. When the git directory
+	-- was explicitly specified, pass that in order to get the local
+	-- git config.
+	go Repo { location = Local { gitdir = d } }
+		| gitDirSpecifiedExplicitly repo = git_config ["--git-dir=."] d
+	-- Run in worktree when there is one, since running in the .git
+	-- directory will trigger safe.bareRepository=explicit, even
+	-- when not in a bare repository.
+	go Repo { location = Local { worktree = Just d } } = git_config [] d
+	go Repo { location = Local { gitdir = d } } = git_config [] d
+	go Repo { location = LocalUnknown d } = git_config [] d
 	go _ = assertLocal repo $ error "internal"
-	git_config d = withCreateProcess p (git_config' p)
+	git_config addparams d = withCreateProcess p (git_config' p)
 	  where
-		params = ["config", "--null", "--list"]
+		params = addparams ++ ["config", "--null", "--list"]
 		p = (proc "git" params)
 			{ cwd = Just (fromRawFilePath d)
 			, env = gitEnv repo
@@ -94,19 +106,23 @@ global = do
 hRead :: Repo -> ConfigStyle -> Handle -> IO Repo
 hRead repo st h = do
 	val <- S.hGetContents h
-	store val st repo
+	let c = parse val st
+	debug (DebugSource "Git.Config") $ "git config read: " ++
+		show (map (\(k, v) -> (show k, map show v)) (M.toList c))
+	storeParsed c repo
 
 {- Stores a git config into a Repo, returning the new version of the Repo.
  - The git config may be multiple lines, or a single line.
  - Config settings can be updated incrementally.
  -}
 store :: S.ByteString -> ConfigStyle -> Repo -> IO Repo
-store s st repo = do
-	let c = parse s st
-	updateLocation $ repo
-		{ config = (M.map Prelude.head c) `M.union` config repo
-		, fullconfig = M.unionWith (++) c (fullconfig repo)
-		}
+store s st = storeParsed (parse s st)
+
+storeParsed :: M.Map ConfigKey [ConfigValue] -> Repo -> IO Repo
+storeParsed c repo = updateLocation $ repo
+	{ config = (M.map Prelude.head c) `M.union` config repo
+	, fullconfig = M.unionWith (++) c (fullconfig repo)
+	}
 
 {- Stores a single config setting in a Repo, returning the new version of
  - the Repo. Config settings can be updated incrementally. -}
@@ -123,14 +139,28 @@ store' k v repo = repo
  - based on the core.bare and core.worktree settings.
  -}
 updateLocation :: Repo -> IO Repo
-updateLocation r@(Repo { location = LocalUnknown d })
-	| isBare r = ifM (doesDirectoryExist (fromRawFilePath dotgit))
-			( updateLocation' r $ Local dotgit Nothing
-			, updateLocation' r $ Local d Nothing
-			)
-	| otherwise = updateLocation' r $ Local dotgit (Just d)
+updateLocation r@(Repo { location = LocalUnknown d }) = case isBare r of
+	Just True -> ifM (doesDirectoryExist (fromRawFilePath dotgit))
+		( updateLocation' r $ Local dotgit Nothing
+		, updateLocation' r $ Local d Nothing
+		)
+	Just False -> mknonbare
+	{- core.bare not in config, probably because safe.directory
+	 - did not allow reading the config -}
+	Nothing -> ifM (Git.Construct.isBareRepo (fromRawFilePath d))
+		( mkbare
+		, mknonbare
+		)
   where
 	dotgit = d P.</> ".git"
+	-- git treats eg ~/foo as a bare git repository located in
+	-- ~/foo/.git if ~/foo/.git/config has core.bare=true
+	mkbare = ifM (doesDirectoryExist (fromRawFilePath dotgit))
+		( updateLocation' r $ Local dotgit Nothing
+		, updateLocation' r $ Local d Nothing
+		)
+	mknonbare = updateLocation' r $ Local dotgit (Just d)
+
 updateLocation r@(Repo { location = l@(Local {}) }) = updateLocation' r l
 updateLocation r = return r
 
@@ -202,8 +232,9 @@ boolConfig' :: Bool -> S.ByteString
 boolConfig' True = "true"
 boolConfig' False = "false"
 
-isBare :: Repo -> Bool
-isBare r = fromMaybe False $ isTrueFalse' =<< getMaybe coreBare r
+{- Note that repoIsLocalBare is often better to use than this. -}
+isBare :: Repo -> Maybe Bool
+isBare r = isTrueFalse' =<< getMaybe coreBare r
 
 coreBare :: ConfigKey
 coreBare = "core.bare"
@@ -273,3 +304,27 @@ unset ck@(ConfigKey k) r = ifM (Git.Command.runBool ps r)
 	)
   where
 	ps = [Param "config", Param "--unset-all", Param (decodeBS k)]
+
+{- git "fixed" CVE-2022-24765 by preventing git-config from
+ - listing per-repo configs when the repo is not owned by
+ - the current user. Detect if this fix is in effect for the
+ - repo.
+ -}
+checkRepoConfigInaccessible :: Repo -> IO Bool
+checkRepoConfigInaccessible r
+	-- When --git-dir or GIT_DIR is used to specify the git
+	-- directory, git does not check for CVE-2022-24765.
+	| gitDirSpecifiedExplicitly r = return False
+	| otherwise = do
+		-- Cannot use gitCommandLine here because specifying --git-dir
+		-- will bypass the git security check.
+		let p = (proc "git" ["config", "--local", "--list"])
+			{ cwd = Just (fromRawFilePath (repoPath r))
+			, env = gitEnv r
+			}
+		(out, ok) <- processTranscript' p Nothing
+		if not ok
+			then do
+				debug (DebugSource "Git.Config") ("config output: " ++ out)
+				return True
+			else return False
diff --git a/Git/Construct.hs b/Git/Construct.hs
index a5e825e..bdab8ed 100644
--- a/Git/Construct.hs
+++ b/Git/Construct.hs
@@ -1,6 +1,6 @@
 {- Construction of Git Repo objects
  -
- - Copyright 2010-2021 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2023 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -23,6 +23,7 @@ module Git.Construct (
 	checkForRepo,
 	newFrom,
 	adjustGitDirFile,
+	isBareRepo,
 ) where
 
 #ifndef mingw32_HOST_OS
@@ -38,6 +39,7 @@ import Git.Remote
 import Git.FilePath
 import qualified Git.Url as Url
 import Utility.UserInfo
+import Utility.Url.Parse
 
 import qualified Data.ByteString as B
 import qualified System.FilePath.ByteString as P
@@ -84,7 +86,7 @@ fromAbsPath :: RawFilePath -> IO Repo
 fromAbsPath dir
 	| absoluteGitPath dir = fromPath dir
 	| otherwise =
-		error $ "internal error, " ++ show dir ++ " is not absolute"
+		giveup $ "internal error, " ++ show dir ++ " is not absolute"
 
 {- Construct a Repo for a remote's url.
  -
@@ -103,10 +105,10 @@ fromUrl url
 
 fromUrl' :: String -> IO Repo
 fromUrl' url
-	| "file://" `isPrefixOf` url = case parseURI url of
+	| "file://" `isPrefixOf` url = case parseURIPortable url of
 		Just u -> fromAbsPath $ toRawFilePath $ unEscapeString $ uriPath u
 		Nothing -> pure $ newFrom $ UnparseableUrl url
-	| otherwise = case parseURI url of
+	| otherwise = case parseURIPortable url of
 		Just u -> pure $ newFrom $ Url u
 		Nothing -> pure $ newFrom $ UnparseableUrl url
 
@@ -128,7 +130,7 @@ localToUrl reference r
 				, auth
 				, fromRawFilePath (repoPath r)
 				]
-			in r { location = Url $ fromJust $ parseURI absurl }
+			in r { location = Url $ fromJust $ parseURIPortable absurl }
 		_ -> r
 
 {- Calculates a list of a repo's configured remotes, by parsing its config. -}
@@ -139,7 +141,7 @@ fromRemotes repo = catMaybes <$> mapM construct remotepairs
 	filterkeys f = filterconfig (\(k,_) -> f k)
 	remotepairs = filterkeys isRemoteUrlKey
 	construct (k,v) = remoteNamedFromKey k $
-		fromRemoteLocation (fromConfigValue v) repo
+		fromRemoteLocation (fromConfigValue v) False repo
 
 {- Sets the name of a remote when constructing the Repo to represent it. -}
 remoteNamed :: String -> IO Repo -> IO Repo
@@ -155,9 +157,15 @@ remoteNamedFromKey k r = case remoteKeyToRemoteName k of
 	Just n -> Just <$> remoteNamed n r
 
 {- Constructs a new Repo for one of a Repo's remotes using a given
- - location (ie, an url). -}
-fromRemoteLocation :: String -> Repo -> IO Repo
-fromRemoteLocation s repo = gen $ parseRemoteLocation s repo
+ - location (ie, an url). 
+ -
+ - knownurl can be true if the location is known to be an url. This allows
+ - urls that don't parse as urls to be used, returning UnparseableUrl.
+ - If knownurl is false, the location may still be an url, if it parses as
+ - one.
+ -}
+fromRemoteLocation :: String -> Bool -> Repo -> IO Repo
+fromRemoteLocation s knownurl repo = gen $ parseRemoteLocation s knownurl repo
   where
 	gen (RemotePath p) = fromRemotePath p repo
 	gen (RemoteUrl u) = fromUrl u
@@ -216,7 +224,7 @@ checkForRepo :: FilePath -> IO (Maybe RepoLocation)
 checkForRepo dir = 
 	check isRepo $
 		check (checkGitDirFile (toRawFilePath dir)) $
-			check isBareRepo $
+			check (checkdir (isBareRepo dir)) $
 				return Nothing
   where
 	check test cont = maybe cont (return . Just) =<< test
@@ -225,16 +233,17 @@ checkForRepo dir =
 		, return Nothing
 		)
 	isRepo = checkdir $ 
-		gitSignature (".git" </> "config")
+		doesFileExist (dir </> ".git" </> "config")
 			<||>
-		-- A git-worktree lacks .git/config, but has .git/commondir.
+		-- A git-worktree lacks .git/config, but has .git/gitdir.
 		-- (Normally the .git is a file, not a symlink, but it can
 		-- be converted to a symlink and git will still work;
 		-- this handles that case.)
-		gitSignature (".git" </> "gitdir")
-	isBareRepo = checkdir $ gitSignature "config"
-		<&&> doesDirectoryExist (dir </> "objects")
-	gitSignature file = doesFileExist $ dir </> file
+		doesFileExist (dir </>  ".git" </> "gitdir")
+
+isBareRepo :: FilePath -> IO Bool
+isBareRepo dir = doesFileExist (dir </> "config")
+	<&&> doesDirectoryExist (dir </> "objects")
 
 -- Check for a .git file.
 checkGitDirFile :: RawFilePath -> IO (Maybe RepoLocation)
@@ -277,5 +286,6 @@ newFrom l = Repo
 	, gitEnv = Nothing
 	, gitEnvOverridesGitDir = False
 	, gitGlobalOpts = []
+	, gitDirSpecifiedExplicitly = False
 	}
 
diff --git a/Git/CurrentRepo.hs b/Git/CurrentRepo.hs
index 9261eab..54e05f4 100644
--- a/Git/CurrentRepo.hs
+++ b/Git/CurrentRepo.hs
@@ -1,6 +1,6 @@
 {- The current git repository.
  -
- - Copyright 2012-2020 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2022 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -79,8 +79,9 @@ get = do
 			{ gitdir = absd
 			, worktree = Just curr
 			}
-		r <- Git.Config.read $ newFrom loc
-		return $ if Git.Config.isBare r
+		r <- Git.Config.read $ (newFrom loc)
+			{ gitDirSpecifiedExplicitly = True }
+		return $ if fromMaybe False (Git.Config.isBare r)
 			then r { location = (location r) { worktree = Nothing } }
 			else r
 	configure Nothing Nothing = giveup "Not in a git repository."
diff --git a/Git/Destroyer.hs b/Git/Destroyer.hs
index 4d84eec..9b75178 100644
--- a/Git/Destroyer.hs
+++ b/Git/Destroyer.hs
@@ -18,7 +18,9 @@ import Git
 import Utility.QuickCheck
 import Utility.FileMode
 import Utility.Tmp
+import qualified Utility.RawFilePath as R
 
+import System.PosixCompat.Files
 import qualified Data.ByteString as B
 import Data.Word
 
@@ -95,12 +97,12 @@ applyDamage ds r = do
 		case d of
 			Empty s -> withfile s $ \f ->
 				withSaneMode f $ do
-					removeWhenExistsWith removeLink f
+					removeWhenExistsWith R.removeLink (toRawFilePath f)
 					writeFile f ""
 			Reverse s -> withfile s $ \f ->
 				withSaneMode f $
 					B.writeFile f =<< B.reverse <$> B.readFile f
-			Delete s -> withfile s $ removeWhenExistsWith removeLink
+			Delete s -> withfile s $ removeWhenExistsWith R.removeLink . toRawFilePath
 			AppendGarbage s garbage ->
 				withfile s $ \f ->
 					withSaneMode f $
@@ -127,15 +129,15 @@ applyDamage ds r = do
 								]
 			ScrambleFileMode s mode ->
 				withfile s $ \f ->
-					setFileMode f mode
+					R.setFileMode (toRawFilePath f) mode
 			SwapFiles a b ->
 				withfile a $ \fa ->
 					withfile b $ \fb -> 
 						unless (fa == fb) $
 							withTmpFile "swap" $ \tmp _ -> do
-								moveFile fa tmp
-								moveFile fb fa
-								moveFile tmp fa
+								moveFile (toRawFilePath fa) (toRawFilePath tmp)
+								moveFile (toRawFilePath fb) (toRawFilePath fa)
+								moveFile (toRawFilePath tmp) (toRawFilePath fa)
   where
 	-- A broken .git/config is not recoverable.
 	-- Don't damage hook scripts, to avoid running arbitrary code. ;)
diff --git a/Git/FilePath.hs b/Git/FilePath.hs
index feed8f6..b27c0c7 100644
--- a/Git/FilePath.hs
+++ b/Git/FilePath.hs
@@ -5,7 +5,7 @@
  - top of the repository even when run in a subdirectory. Adding some
  - types helps keep that straight.
  -
- - Copyright 2012-2019 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2023 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -30,12 +30,12 @@ module Git.FilePath (
 
 import Common
 import Git
+import Git.Quote
 
 import qualified System.FilePath.ByteString as P
 import qualified System.FilePath.Posix.ByteString
 import GHC.Generics
 import Control.DeepSeq
-import qualified Data.ByteString as S
 
 {- A RawFilePath, relative to the top of the git repository. -}
 newtype TopFilePath = TopFilePath { getTopFilePath :: RawFilePath }
@@ -46,11 +46,11 @@ instance NFData TopFilePath
 {- A file in a branch or other treeish. -}
 data BranchFilePath = BranchFilePath Ref TopFilePath
 	deriving (Show, Eq, Ord)
-
+ 
 {- Git uses the branch:file form to refer to a BranchFilePath -}
-descBranchFilePath :: BranchFilePath -> S.ByteString
+descBranchFilePath :: BranchFilePath -> StringContainingQuotedPath
 descBranchFilePath (BranchFilePath b f) =
-	fromRef' b <> ":" <> getTopFilePath f
+	UnquotedByteString (fromRef' b) <> ":" <> QuotedPath (getTopFilePath f)
 
 {- Path to a TopFilePath, within the provided git repo. -}
 fromTopFilePath :: TopFilePath -> Git.Repo -> RawFilePath
diff --git a/Git/Filename.hs b/Git/Filename.hs
deleted file mode 100644
index 2fa4c59..0000000
--- a/Git/Filename.hs
+++ /dev/null
@@ -1,49 +0,0 @@
-{- Some git commands output encoded filenames, in a rather annoyingly complex
- - C-style encoding.
- -
- - Copyright 2010, 2011 Joey Hess <id@joeyh.name>
- -
- - Licensed under the GNU AGPL version 3 or higher.
- -}
-
-module Git.Filename where
-
-import Common
-import Utility.Format (decode_c, encode_c)
-import Utility.QuickCheck
-
-import Data.Char
-import Data.Word
-import qualified Data.ByteString as S
-
--- encoded filenames will be inside double quotes
-decode :: S.ByteString -> RawFilePath
-decode b = case S.uncons b of
-	Nothing -> b
-	Just (h, t)
-		| h /= q -> b
-		| otherwise -> case S.unsnoc t of
-			Nothing -> b
-			Just (i, l)
-				| l /= q -> b
-				| otherwise ->
-					encodeBS $ decode_c $ decodeBS i
-  where
-  	q :: Word8
-	q = fromIntegral (ord '"')
-
-{- Should not need to use this, except for testing decode. -}
-encode :: RawFilePath -> S.ByteString
-encode s = encodeBS $ "\"" ++ encode_c (decodeBS s) ++ "\""
-
--- Encoding and then decoding roundtrips only when the string does not
--- contain high unicode, because eg,  both "\12345" and "\227\128\185"
--- are encoded to "\343\200\271".
---
--- That is not a real-world problem, and using TestableFilePath
--- limits what's tested to ascii, so avoids running into it.
-prop_encode_decode_roundtrip :: TestableFilePath -> Bool
-prop_encode_decode_roundtrip ts = 
-	s == fromRawFilePath (decode (encode (toRawFilePath s)))
-  where
-	s = fromTestableFilePath ts
diff --git a/Git/HashObject.hs b/Git/HashObject.hs
index 98bd440..1474c57 100644
--- a/Git/HashObject.hs
+++ b/Git/HashObject.hs
@@ -1,6 +1,6 @@
 {- git hash-object interface
  -
- - Copyright 2011-2019 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2023 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -21,26 +21,47 @@ import qualified Data.ByteString as S
 import qualified Data.ByteString.Char8 as S8
 import qualified Data.ByteString.Lazy as L
 import Data.ByteString.Builder
+import Data.Char
 
-type HashObjectHandle = CoProcess.CoProcessHandle
+data HashObjectHandle = HashObjectHandle CoProcess.CoProcessHandle Repo [CommandParam]
 
 hashObjectStart :: Bool -> Repo -> IO HashObjectHandle
-hashObjectStart writeobject = gitCoProcessStart True $ catMaybes
-	[ Just (Param "hash-object")
-	, if writeobject then Just (Param "-w") else Nothing
-	, Just (Param "--stdin-paths")
-	, Just (Param "--no-filters")
-	]
+hashObjectStart writeobject repo = do
+	h <- gitCoProcessStart True (ps ++ [Param "--stdin-paths"]) repo
+	return (HashObjectHandle h repo ps)
+  where
+	ps = catMaybes
+		[ Just (Param "hash-object")
+		, if writeobject then Just (Param "-w") else Nothing
+		, Just (Param "--no-filters")
+		]
 
 hashObjectStop :: HashObjectHandle -> IO ()
-hashObjectStop = CoProcess.stop
+hashObjectStop (HashObjectHandle h _ _) = CoProcess.stop h
 
 {- Injects a file into git, returning the Sha of the object. -}
 hashFile :: HashObjectHandle -> RawFilePath -> IO Sha
-hashFile h file = CoProcess.query h send receive
+hashFile hdl@(HashObjectHandle h _ _) file = do
+	-- git hash-object chdirs to the top of the repository on
+	-- start, so if the filename is relative, it will
+	-- not work. This seems likely to be a git bug.
+	-- So, make the filename absolute, which will work now
+	-- and also if git's behavior later changes.
+	file' <- absPath file
+	if newline `S.elem` file'
+		then hashFile' hdl file
+		else CoProcess.query h (send file') receive
   where
-	send to = S8.hPutStrLn to =<< absPath file
+	send file' to = S8.hPutStrLn to file'
 	receive from = getSha "hash-object" $ S8.hGetLine from
+	newline = fromIntegral (ord '\n')
+
+{- Runs git hash-object once per call, rather than using a running
+ - one, so is slower. But, is able to handle newlines in the filepath,
+ - which --stdin-paths cannot. -}
+hashFile' :: HashObjectHandle -> RawFilePath -> IO Sha
+hashFile' (HashObjectHandle _ repo ps) file = getSha "hash-object" $
+	pipeReadStrict (ps ++ [File (fromRawFilePath file)]) repo
 
 class HashableBlob t where
 	hashableBlobToHandle :: Handle -> t -> IO ()
diff --git a/Git/LsFiles.hs b/Git/LsFiles.hs
index cc824f2..4eea395 100644
--- a/Git/LsFiles.hs
+++ b/Git/LsFiles.hs
@@ -325,7 +325,7 @@ reduceUnmerged c (i:is) = reduceUnmerged (new:c) rest
 		&& isus x || isus y
 		&& not (isus x && isus y)
 
-{- Gets the InodeCache equivilant information stored in the git index.
+{- Gets the InodeCache equivalent information stored in the git index.
  -
  - Note that this uses a --debug option whose output could change at some
  - point in the future. If the output is not as expected, will use Nothing.
diff --git a/Git/LsTree.hs b/Git/LsTree.hs
index fb3b3e1..9129d18 100644
--- a/Git/LsTree.hs
+++ b/Git/LsTree.hs
@@ -23,7 +23,7 @@ import Common
 import Git
 import Git.Command
 import Git.FilePath
-import qualified Git.Filename
+import qualified Git.Quote
 import Utility.Attoparsec
 
 import Numeric
@@ -137,7 +137,7 @@ parserLsTree long = case long of
 		-- sha
 		<*> (Ref <$> A8.takeTill A8.isSpace)
 
-	fileparser = asTopFilePath . Git.Filename.decode <$> A.takeByteString
+	fileparser = asTopFilePath . Git.Quote.unquote <$> A.takeByteString
 
 	sizeparser = fmap Just A8.decimal
 
diff --git a/Git/Quote.hs b/Git/Quote.hs
new file mode 100644
index 0000000..2ca442e
--- /dev/null
+++ b/Git/Quote.hs
@@ -0,0 +1,122 @@
+{- Some git commands output quoted filenames, in a rather annoyingly complex
+ - C-style encoding.
+ -
+ - Copyright 2010-2023 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU AGPL version 3 or higher.
+ -}
+
+{-# LANGUAGE OverloadedStrings, TypeSynonymInstances #-}
+
+module Git.Quote (
+	unquote,
+	quote,
+	noquote,
+	QuotePath(..),
+	StringContainingQuotedPath(..),
+	quotedPaths,
+	prop_quote_unquote_roundtrip,
+) where
+
+import Common
+import Utility.Format (decode_c, encode_c, encode_c', isUtf8Byte)
+import Utility.QuickCheck
+import Utility.SafeOutput
+
+import Data.Char
+import Data.Word
+import Data.String
+import qualified Data.ByteString as S
+import qualified Data.Semigroup as Sem
+import Prelude
+
+unquote :: S.ByteString -> RawFilePath
+unquote b = case S.uncons b of
+	Nothing -> b
+	Just (h, t)
+		| h /= q -> b
+		| otherwise -> case S.unsnoc t of
+			Nothing -> b
+			Just (i, l)
+				| l /= q -> b
+				| otherwise -> decode_c i
+  where
+  	q :: Word8
+	q = fromIntegral (ord '"')
+
+-- always encodes and double quotes, even in cases that git does not
+quoteAlways :: RawFilePath -> S.ByteString
+quoteAlways s = "\"" <> encode_c needencode s <> "\""
+  where
+	needencode c = isUtf8Byte c || c == fromIntegral (ord '"')
+
+-- git config core.quotePath controls whether to quote unicode characters
+newtype QuotePath = QuotePath Bool
+
+class Quoteable t where
+	-- double quotes and encodes when git would
+	quote :: QuotePath -> t -> S.ByteString
+
+	noquote :: t -> S.ByteString
+
+instance Quoteable RawFilePath where
+	quote (QuotePath qp) s = case encode_c' needencode s of
+		Nothing -> s
+		Just s' -> "\"" <> s' <> "\""
+	  where
+		needencode c
+			| c == fromIntegral (ord '"') = True
+			| qp = isUtf8Byte c
+			| otherwise = False
+
+	noquote = id
+
+-- Allows building up a string that contains paths, which will get quoted.
+-- With OverloadedStrings, strings are passed through without quoting.
+-- Eg: QuotedPath f <> ": not found"
+data StringContainingQuotedPath
+	= UnquotedString String 
+	| UnquotedByteString S.ByteString 
+	| QuotedPath RawFilePath
+	| StringContainingQuotedPath :+: StringContainingQuotedPath
+	deriving (Show, Eq)
+
+quotedPaths :: [RawFilePath] -> StringContainingQuotedPath
+quotedPaths [] = mempty
+quotedPaths (p:ps) = QuotedPath p <> if null ps
+	then mempty
+	else " " <> quotedPaths ps
+
+instance Quoteable StringContainingQuotedPath where
+	quote _ (UnquotedString s) = safeOutput (encodeBS s)
+	quote _ (UnquotedByteString s) = safeOutput s
+	quote qp (QuotedPath p) = quote qp p
+	quote qp (a :+: b) = quote qp a <> quote qp b
+
+	noquote (UnquotedString s) = encodeBS s
+	noquote (UnquotedByteString s) = s
+	noquote (QuotedPath p) = p
+	noquote (a :+: b) = noquote a <> noquote b
+
+instance IsString StringContainingQuotedPath where
+	fromString = UnquotedByteString . encodeBS
+
+instance Sem.Semigroup StringContainingQuotedPath where
+	UnquotedString a <> UnquotedString b = UnquotedString (a <> b)
+	UnquotedByteString a <> UnquotedByteString b = UnquotedByteString (a <> b)
+	a <> b = a :+: b
+
+instance Monoid StringContainingQuotedPath where
+	mempty = UnquotedByteString mempty
+
+-- Encoding and then decoding roundtrips only when the string does not
+-- contain high unicode, because eg, both "\12345" and "\227\128\185"
+-- are encoded to "\343\200\271".
+--
+-- That is not a real-world problem, and using TestableFilePath
+-- limits what's tested to ascii, so avoids running into it.
+prop_quote_unquote_roundtrip :: TestableFilePath -> Bool
+prop_quote_unquote_roundtrip ts = 
+	s == fromRawFilePath (unquote (quoteAlways (toRawFilePath s)))
+  where
+	s = fromTestableFilePath ts
diff --git a/Git/Remote.hs b/Git/Remote.hs
index 80accca..9cdaad6 100644
--- a/Git/Remote.hs
+++ b/Git/Remote.hs
@@ -43,7 +43,7 @@ remoteKeyToRemoteName (ConfigKey k)
 {- 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,
- - just some ad-hoc checks, and some other things that fail with certian
+ - just some ad-hoc checks, and some other things that fail with certain
  - types of names (like ones starting with '-').
  -}
 makeLegalName :: String -> RemoteName
@@ -63,7 +63,7 @@ makeLegalName s = case filter legal $ replace "/" "_" s of
 	legal c = isAlphaNum c
 	
 data RemoteLocation = RemoteUrl String | RemotePath FilePath
-	deriving (Eq)
+	deriving (Eq, Show)
 
 remoteLocationIsUrl :: RemoteLocation -> Bool
 remoteLocationIsUrl (RemoteUrl _) = True
@@ -75,16 +75,18 @@ remoteLocationIsSshUrl _ = False
 
 {- Determines if a given remote location is an url, or a local
  - path. Takes the repository's insteadOf configuration into account. -}
-parseRemoteLocation :: String -> Repo -> RemoteLocation
-parseRemoteLocation s repo = ret $ calcloc s
+parseRemoteLocation :: String -> Bool -> Repo -> RemoteLocation
+parseRemoteLocation s knownurl repo = go
   where
-	ret v
+ 	s' = calcloc s
+	go
 #ifdef mingw32_HOST_OS
-		| dosstyle v = RemotePath (dospath v)
+		| dosstyle s' = RemotePath (dospath s')
 #endif
-		| scpstyle v = RemoteUrl (scptourl v)
-		| urlstyle v = RemoteUrl v
-		| otherwise = RemotePath v
+		| scpstyle s' = RemoteUrl (scptourl s')
+		| urlstyle s' = RemoteUrl s'
+		| knownurl && s' == s = RemoteUrl s'
+		| otherwise = RemotePath s'
 	-- insteadof config can rewrite remote location
 	calcloc l
 		| null insteadofs = l
diff --git a/Git/Repair.hs b/Git/Repair.hs
index 7d47f84..cea57df 100644
--- a/Git/Repair.hs
+++ b/Git/Repair.hs
@@ -30,6 +30,7 @@ import Git.Types
 import Git.Fsck
 import Git.Index
 import Git.Env
+import Git.FilePath
 import qualified Git.Config as Config
 import qualified Git.Construct as Construct
 import qualified Git.LsTree as LsTree
@@ -95,7 +96,7 @@ explodePacks r = go =<< listPackFiles r
 			let dest = objectsDir r P.</> f
 			createDirectoryIfMissing True
 				(fromRawFilePath (parentDir dest))
-			moveFile objfile (fromRawFilePath dest)
+			moveFile (toRawFilePath objfile) dest
 		forM_ packs $ \packfile -> do
 			let f = toRawFilePath packfile
 			removeWhenExistsWith R.removeLink f
@@ -103,7 +104,7 @@ explodePacks r = go =<< listPackFiles r
 		return True
 
 {- Try to retrieve a set of missing objects, from the remotes of a
- - repository. Returns any that could not be retreived.
+ - repository. Returns any that could not be retrieved.
  -
  - If another clone of the repository exists locally, which might not be a
  - remote of the repo being repaired, its path can be passed as a reference
@@ -252,7 +253,8 @@ getAllRefs r = getAllRefs' (fromRawFilePath (localGitDir r) </> "refs")
 getAllRefs' :: FilePath -> IO [Ref]
 getAllRefs' refdir = do
 	let topsegs = length (splitPath refdir) - 1
-	let toref = Ref . encodeBS . joinPath . drop topsegs . splitPath
+	let toref = Ref . toInternalGitPath . encodeBS 
+		. joinPath . drop topsegs . splitPath
 	map toref <$> dirContentsRecursive refdir
 
 explodePackedRefsFile :: Repo -> IO ()
@@ -269,7 +271,7 @@ explodePackedRefsFile r = do
 		let gitd = localGitDir r
 		let dest = gitd P.</> fromRef' ref
 		let dest' = fromRawFilePath dest
-		createDirectoryUnder gitd (parentDir dest)
+		createDirectoryUnder [gitd] (parentDir dest)
 		unlessM (doesFileExist dest') $
 			writeFile dest' (fromRef sha)
 
@@ -433,7 +435,7 @@ rewriteIndex r
 	reinject (file, sha, mode, _) = case toTreeItemType mode of
 		Nothing -> return Nothing
 		Just treeitemtype -> Just <$>
-			UpdateIndex.stageFile sha treeitemtype (fromRawFilePath file) r
+			UpdateIndex.stageFile sha treeitemtype file r
 
 newtype GoodCommits = GoodCommits (S.Set Sha)
 
diff --git a/Git/Sha.hs b/Git/Sha.hs
index a66c34e..389bcc0 100644
--- a/Git/Sha.hs
+++ b/Git/Sha.hs
@@ -20,7 +20,7 @@ import Data.Char
 getSha :: String -> IO S.ByteString -> IO Sha
 getSha subcommand a = maybe bad return =<< extractSha <$> a
   where
-	bad = error $ "failed to read sha from git " ++ subcommand
+	bad = giveup $ "failed to read sha from git " ++ subcommand
 
 {- Extracts the Sha from a ByteString. 
  -
diff --git a/Git/Types.hs b/Git/Types.hs
index 68045fc..ce1818e 100644
--- a/Git/Types.hs
+++ b/Git/Types.hs
@@ -51,6 +51,8 @@ data Repo = Repo
 	, gitEnvOverridesGitDir :: Bool
 	-- global options to pass to git when running git commands
 	, gitGlobalOpts :: [CommandParam]
+	-- True only when --git-dir or GIT_DIR was used
+	, gitDirSpecifiedExplicitly :: Bool
 	} deriving (Show, Eq, Ord)
 
 newtype ConfigKey = ConfigKey S.ByteString
diff --git a/Git/UpdateIndex.hs b/Git/UpdateIndex.hs
index 74816a6..f56bc86 100644
--- a/Git/UpdateIndex.hs
+++ b/Git/UpdateIndex.hs
@@ -1,6 +1,6 @@
 {- git-update-index library
  -
- - Copyright 2011-2020 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2022 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -99,15 +99,15 @@ updateIndexLine sha treeitemtype file = L.fromStrict $
 	<> "\t"
 	<> indexPath file
 
-stageFile :: Sha -> TreeItemType -> FilePath -> Repo -> IO Streamer
+stageFile :: Sha -> TreeItemType -> RawFilePath -> Repo -> IO Streamer
 stageFile sha treeitemtype file repo = do
-	p <- toTopFilePath (toRawFilePath file) repo
+	p <- toTopFilePath file repo
 	return $ pureStreamer $ updateIndexLine sha treeitemtype p
 
 {- A streamer that removes a file from the index. -}
-unstageFile :: FilePath -> Repo -> IO Streamer
+unstageFile :: RawFilePath -> Repo -> IO Streamer
 unstageFile file repo = do
-	p <- toTopFilePath (toRawFilePath file) repo
+	p <- toTopFilePath file repo
 	return $ unstageFile' p
 
 unstageFile' :: TopFilePath -> Streamer
@@ -135,9 +135,17 @@ stageDiffTreeItem d = case toTreeItemType (Diff.dstmode d) of
 indexPath :: TopFilePath -> InternalGitPath
 indexPath = toInternalGitPath . getTopFilePath
 
-{- Refreshes the index, by checking file stat information.  -}
-refreshIndex :: Repo -> ((RawFilePath -> IO ()) -> IO ()) -> IO Bool
-refreshIndex repo feeder = withCreateProcess p go
+{- Refreshes the index, by checking file stat information.
+ -
+ - The action is passed a callback that it can use to send filenames to
+ - update-index. Sending Nothing will wait for update-index to finish
+ - updating the index.
+ -}
+refreshIndex :: (MonadIO m, MonadMask m) => Repo -> ((Maybe RawFilePath -> IO ()) -> m ()) -> m ()
+refreshIndex repo feeder = bracket
+	(liftIO $ createProcess p)
+	(liftIO . cleanupProcess)
+	go
   where
 	params = 
 		[ Param "update-index"
@@ -150,10 +158,12 @@ refreshIndex repo feeder = withCreateProcess p go
 	p = (gitCreateProcess params repo)
 		{ std_in = CreatePipe }
 
-	go (Just h) _ _ pid = do
-		feeder $ \f ->
-			S.hPut h (S.snoc f 0)
-		hFlush h
-		hClose h
-		checkSuccessProcess pid
-	go _ _ _ _ = error "internal"
+	go (Just h, _, _, pid) = do
+		let closer = do
+			hClose h
+			forceSuccessProcess p pid
+		feeder $ \case
+			Just f -> S.hPut h (S.snoc f 0)
+			Nothing -> closer
+		liftIO $ closer
+	go _ = error "internal"