From edf83982be214f3c839fab9b659f645de53a9100 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Mon, 14 Aug 2023 12:06:32 -0400
Subject: merge from git-annex

Support building with unix-compat 0.7
---
 Utility/CopyFile.hs           |  13 ++--
 Utility/DataUnits.hs          |  56 +++++++++++-----
 Utility/Directory.hs          |  10 +--
 Utility/Directory/Create.hs   |  51 ++++++++-------
 Utility/Exception.hs          |  27 +++++---
 Utility/FileMode.hs           |  38 ++++++-----
 Utility/FileSize.hs           |   6 +-
 Utility/Format.hs             | 149 ++++++++++++++++++++++++++----------------
 Utility/InodeCache.hs         |  16 +++--
 Utility/Metered.hs            |   7 +-
 Utility/Misc.hs               |  10 ++-
 Utility/Monad.hs              |   8 +++
 Utility/MoveFile.hs           |  25 ++++---
 Utility/Path.hs               |   5 +-
 Utility/Path/AbsRel.hs        |   2 +-
 Utility/Process.hs            |   7 +-
 Utility/Process/Transcript.hs |  97 +++++++++++++++++++++++++++
 Utility/QuickCheck.hs         |   1 +
 Utility/RawFilePath.hs        |  59 +++++++++++++----
 Utility/SafeOutput.hs         |  36 ++++++++++
 Utility/SystemDirectory.hs    |   2 +-
 Utility/Tmp.hs                |   7 +-
 Utility/Url/Parse.hs          |  63 ++++++++++++++++++
 Utility/UserInfo.hs           |  27 ++++----
 24 files changed, 538 insertions(+), 184 deletions(-)
 create mode 100644 Utility/Process/Transcript.hs
 create mode 100644 Utility/SafeOutput.hs
 create mode 100644 Utility/Url/Parse.hs

(limited to 'Utility')

diff --git a/Utility/CopyFile.hs b/Utility/CopyFile.hs
index 9c93e70..207153d 100644
--- a/Utility/CopyFile.hs
+++ b/Utility/CopyFile.hs
@@ -14,6 +14,7 @@ module Utility.CopyFile (
 
 import Common
 import qualified BuildInfo
+import qualified Utility.RawFilePath as R
 
 data CopyMetaData 
 	-- Copy timestamps when possible, but no other metadata, and
@@ -60,9 +61,6 @@ copyFileExternal meta src dest = do
  -
  - 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
@@ -82,14 +80,17 @@ copyCoW meta src dest
 		return ok
 	| otherwise = return False
   where
+ 	-- Note that in coreutils 9.0, cp uses CoW by default,
+	-- without needing an option. This s only needed to support 
+	-- older versions.
 	params = Param "--reflink=always" : copyMetaDataParams meta
 
 {- Create a hard link if the filesystem allows it, and fall back to copying
  - the file. -}
-createLinkOrCopy :: FilePath -> FilePath -> IO Bool
+createLinkOrCopy :: RawFilePath -> RawFilePath -> IO Bool
 createLinkOrCopy src dest = go `catchIO` const fallback
   where
 	go = do
-		createLink src dest
+		R.createLink src dest
 		return True
-	fallback = copyFileExternal CopyAllMetaData src dest
+	fallback = copyFileExternal CopyAllMetaData (fromRawFilePath src) (fromRawFilePath dest)
diff --git a/Utility/DataUnits.hs b/Utility/DataUnits.hs
index a6c9ffc..8d910c6 100644
--- a/Utility/DataUnits.hs
+++ b/Utility/DataUnits.hs
@@ -1,6 +1,6 @@
 {- data size display and parsing
  -
- - Copyright 2011 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2022 Joey Hess <id@joeyh.name>
  -
  - License: BSD-2-clause
  -
@@ -21,14 +21,20 @@
  - error. This was bad.
  -
  - So, a committee was formed. And it arrived at a committee-like decision,
- - which satisfied noone, confused everyone, and made the world an uglier
- - place. As with all committees, this was meh.
+ - which satisfied no one, confused everyone, and made the world an uglier
+ - place. As with all committees, this was meh. Or in this case, "mib".
  -
  - And the drive manufacturers happily continued selling drives that are
  - increasingly smaller than you'd expect, if you don't count on your
  - fingers. But that are increasingly too big for anyone to much notice.
  - This caused me to need git-annex.
  -
+ - Meanwhile, over in telecommunications land, they were using entirely
+ - different units that differ only in capitalization sometimes.
+ - (At one point this convinced me that it was a good idea to buy an ISDN
+ - line because 128 kb/s sounded really fast! But it was really only 128
+ - kbit/s...)
+ -
  - Thus, I use units here that I loathe. Because if I didn't, people would
  - be confused that their drives seem the wrong size, and other people would
  - complain at me for not being standards compliant. And we call this
@@ -38,7 +44,7 @@
 module Utility.DataUnits (
 	dataUnits,
 	storageUnits,
-	memoryUnits,
+	committeeUnits,
 	bandwidthUnits,
 	oldSchoolUnits,
 	Unit(..),
@@ -62,28 +68,30 @@ data Unit = Unit ByteSize Abbrev Name
 	deriving (Ord, Show, Eq)
 
 dataUnits :: [Unit]
-dataUnits = storageUnits ++ memoryUnits
+dataUnits = storageUnits ++ committeeUnits ++ bandwidthUnits
 
 {- Storage units are (stupidly) powers of ten. -}
 storageUnits :: [Unit]
 storageUnits =
-	[ Unit (p 8) "YB" "yottabyte"
+	[ Unit (p 10) "QB" "quettabyte"
+	, Unit (p 9) "RB" "ronnabyte"
+	, Unit (p 8) "YB" "yottabyte"
 	, Unit (p 7) "ZB" "zettabyte"
 	, Unit (p 6) "EB" "exabyte"
 	, Unit (p 5) "PB" "petabyte"
 	, Unit (p 4) "TB" "terabyte"
 	, Unit (p 3) "GB" "gigabyte"
 	, Unit (p 2) "MB" "megabyte"
-	, Unit (p 1) "kB" "kilobyte" -- weird capitalization thanks to committe
-	, Unit (p 0) "B" "byte"
+	, Unit (p 1) "kB" "kilobyte" -- weird capitalization thanks to committee
+	, Unit 1 "B" "byte"
 	]
   where
 	p :: Integer -> Integer
 	p n = 1000^n
 
-{- Memory units are (stupidly named) powers of 2. -}
-memoryUnits :: [Unit]
-memoryUnits =
+{- Committee units are (stupidly named) powers of 2. -}
+committeeUnits :: [Unit]
+committeeUnits =
 	[ Unit (p 8) "YiB" "yobibyte"
 	, Unit (p 7) "ZiB" "zebibyte"
 	, Unit (p 6) "EiB" "exbibyte"
@@ -92,19 +100,37 @@ memoryUnits =
 	, Unit (p 3) "GiB" "gibibyte"
 	, Unit (p 2) "MiB" "mebibyte"
 	, Unit (p 1) "KiB" "kibibyte"
-	, Unit (p 0) "B" "byte"
+	, Unit 1 "B" "byte"
 	]
   where
 	p :: Integer -> Integer
 	p n = 2^(n*10)
 
-{- Bandwidth units are only measured in bits if you're some crazy telco. -}
+{- Bandwidth units are (stupidly) measured in bits, not bytes, and are
+ - (also stupidly) powers of ten. 
+ -
+ - While it's fairly common for "Mb", "Gb" etc to be used, that differs
+ - from "MB", "GB", etc only in case, and readSize is case-insensitive.
+ - So "Mbit", "Gbit" etc are used instead to avoid parsing ambiguity.
+ -}
 bandwidthUnits :: [Unit]
-bandwidthUnits = error "stop trying to rip people off"
+bandwidthUnits =
+	[ Unit (p 8) "Ybit" "yottabit"
+	, Unit (p 7) "Zbit" "zettabit"
+	, Unit (p 6) "Ebit" "exabit"
+	, Unit (p 5) "Pbit" "petabit"
+	, Unit (p 4) "Tbit" "terabit"
+	, Unit (p 3) "Gbit" "gigabit"
+	, Unit (p 2) "Mbit" "megabit"
+	, Unit (p 1) "kbit" "kilobit" -- weird capitalization thanks to committee
+	]
+  where
+	p :: Integer -> Integer
+	p n = (1000^n) `div` 8
 
 {- Do you yearn for the days when men were men and megabytes were megabytes? -}
 oldSchoolUnits :: [Unit]
-oldSchoolUnits = zipWith (curry mingle) storageUnits memoryUnits
+oldSchoolUnits = zipWith (curry mingle) storageUnits committeeUnits
   where
 	mingle (Unit _ a n, Unit s' _ _) = Unit s' a n
 
diff --git a/Utility/Directory.hs b/Utility/Directory.hs
index 38adf17..a5c023f 100644
--- a/Utility/Directory.hs
+++ b/Utility/Directory.hs
@@ -16,7 +16,7 @@ module Utility.Directory (
 
 import Control.Monad
 import System.FilePath
-import System.PosixCompat.Files hiding (removeLink)
+import System.PosixCompat.Files (isDirectory, isSymbolicLink)
 import Control.Applicative
 import System.IO.Unsafe (unsafeInterleaveIO)
 import Data.Maybe
@@ -25,7 +25,8 @@ import Prelude
 import Utility.SystemDirectory
 import Utility.Exception
 import Utility.Monad
-import Utility.Applicative
+import Utility.FileSystemEncoding
+import qualified Utility.RawFilePath as R
 
 dirCruft :: FilePath -> Bool
 dirCruft "." = True
@@ -65,7 +66,7 @@ dirContentsRecursiveSkipping skipdir followsubdirsymlinks topdir = go [topdir]
 		| otherwise = do
 			let skip = collect (entry:files) dirs' entries
 			let recurse = collect files (entry:dirs') entries
-			ms <- catchMaybeIO $ getSymbolicLinkStatus entry
+			ms <- catchMaybeIO $ R.getSymbolicLinkStatus (toRawFilePath entry)
 			case ms of
 				(Just s) 
 					| isDirectory s -> recurse
@@ -87,9 +88,10 @@ dirTreeRecursiveSkipping skipdir topdir = go [] [topdir]
 		| skipdir (takeFileName dir) = go c dirs
 		| otherwise = unsafeInterleaveIO $ do
 			subdirs <- go []
-				=<< filterM (isDirectory <$$> getSymbolicLinkStatus)
+				=<< filterM isdir
 				=<< catchDefaultIO [] (dirContents dir)
 			go (subdirs++dir:c) dirs
+	isdir p = isDirectory <$> R.getSymbolicLinkStatus (toRawFilePath p)
 
 {- Use with an action that removes something, which may or may not exist.
  -
diff --git a/Utility/Directory/Create.hs b/Utility/Directory/Create.hs
index 32c0bcf..5650f96 100644
--- a/Utility/Directory/Create.hs
+++ b/Utility/Directory/Create.hs
@@ -31,10 +31,10 @@ import qualified Utility.RawFilePath as R
 import Utility.PartialPrelude
 
 {- Like createDirectoryIfMissing True, but it will only create
- - missing parent directories up to but not including the directory
- - in the first parameter.
+ - missing parent directories up to but not including a directory
+ - from the first parameter.
  -
- - For example, createDirectoryUnder "/tmp/foo" "/tmp/foo/bar/baz"
+ - For example, createDirectoryUnder ["/tmp/foo"] "/tmp/foo/bar/baz"
  - will create /tmp/foo/bar if necessary, but if /tmp/foo does not exist,
  - it will throw an exception.
  -
@@ -45,40 +45,43 @@ import Utility.PartialPrelude
  - FilePath (or the same as it), it will fail with an exception
  - even if the second FilePath's parent directory already exists.
  -
- - Either or both of the FilePaths can be relative, or absolute.
+ - The FilePaths can be relative, or absolute. 
  - They will be normalized as necessary.
  -
  - Note that, the second FilePath, if relative, is relative to the current
- - working directory, not to the first FilePath.
+ - working directory.
  -}
-createDirectoryUnder :: RawFilePath -> RawFilePath -> IO ()
-createDirectoryUnder topdir dir =
-	createDirectoryUnder' topdir dir R.createDirectory
+createDirectoryUnder :: [RawFilePath] -> RawFilePath -> IO ()
+createDirectoryUnder topdirs dir =
+	createDirectoryUnder' topdirs dir R.createDirectory
 
 createDirectoryUnder'
 	:: (MonadIO m, MonadCatch m)
-	=> RawFilePath
+	=> [RawFilePath]
 	-> RawFilePath
 	-> (RawFilePath -> m ())
 	-> m ()
-createDirectoryUnder' topdir dir0 mkdir = do
-	p <- liftIO $ relPathDirToFile topdir dir0
-	let dirs = P.splitDirectories p
-	-- Catch cases where the dir is not beneath the topdir.
+createDirectoryUnder' topdirs dir0 mkdir = do
+	relps <- liftIO $ forM topdirs $ \topdir -> relPathDirToFile topdir dir0
+	let relparts = map P.splitDirectories relps
+	-- Catch cases where dir0 is not beneath a topdir.
 	-- If the relative path between them starts with "..",
 	-- it's not. And on Windows, if they are on different drives,
 	-- the path will not be relative.
-	if headMaybe dirs == Just ".." || P.isAbsolute p
-		then liftIO $ ioError $ customerror userErrorType
-			("createDirectoryFrom: not located in " ++ fromRawFilePath topdir)
-		-- If dir0 is the same as the topdir, don't try to create
-		-- it, but make sure it does exist.
-		else if null dirs
-			then liftIO $ unlessM (doesDirectoryExist (fromRawFilePath topdir)) $
-				ioError $ customerror doesNotExistErrorType
-					"createDirectoryFrom: does not exist"
-			else createdirs $
-				map (topdir P.</>) (reverse (scanl1 (P.</>) dirs))
+	let notbeneath = \(_topdir, (relp, dirs)) -> 
+		headMaybe dirs /= Just ".." && not (P.isAbsolute relp)
+	case filter notbeneath $ zip topdirs (zip relps relparts) of
+		((topdir, (_relp, dirs)):_)
+			-- If dir0 is the same as the topdir, don't try to
+			-- create it, but make sure it does exist.
+			| null dirs ->
+				liftIO $ unlessM (doesDirectoryExist (fromRawFilePath topdir)) $
+					ioError $ customerror doesNotExistErrorType $
+						"createDirectoryFrom: " ++ fromRawFilePath topdir ++ " does not exist"
+			| otherwise -> createdirs $
+					map (topdir P.</>) (reverse (scanl1 (P.</>) dirs))
+		_ -> liftIO $ ioError $ customerror userErrorType
+			("createDirectoryFrom: not located in " ++ unwords (map fromRawFilePath topdirs))
   where
 	customerror t s = mkIOError t s Nothing (Just (fromRawFilePath dir0))
 
diff --git a/Utility/Exception.hs b/Utility/Exception.hs
index 4c60eac..cf55c5f 100644
--- a/Utility/Exception.hs
+++ b/Utility/Exception.hs
@@ -1,6 +1,6 @@
 {- Simple IO exception handling (and some more)
  -
- - Copyright 2011-2016 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2023 Joey Hess <id@joeyh.name>
  -
  - License: BSD-2-clause
  -}
@@ -20,6 +20,7 @@ module Utility.Exception (
 	bracketIO,
 	catchNonAsync,
 	tryNonAsync,
+	nonAsyncHandler,
 	tryWhenExists,
 	catchIOErrorType,
 	IOErrorType(..),
@@ -28,21 +29,24 @@ module Utility.Exception (
 
 import Control.Monad.Catch as X hiding (Handler)
 import qualified Control.Monad.Catch as M
-import Control.Exception (IOException, AsyncException)
-import Control.Exception (SomeAsyncException)
+import Control.Exception (IOException, AsyncException, SomeAsyncException)
 import Control.Monad
 import Control.Monad.IO.Class (liftIO, MonadIO)
 import System.IO.Error (isDoesNotExistError, ioeGetErrorType)
 import GHC.IO.Exception (IOErrorType(..))
 
 import Utility.Data
+import Utility.SafeOutput
 
 {- 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 expected to see in some
- - circumstances. -}
+ - circumstances.
+ -
+ - Also, control characters are filtered out of the message.
+ -}
 giveup :: [Char] -> a
-giveup = errorWithoutStackTrace
+giveup = errorWithoutStackTrace . safeOutput
 
 {- Catches IO errors and returns a Bool -}
 catchBoolIO :: MonadCatch m => m Bool -> m Bool
@@ -81,11 +85,7 @@ bracketIO setup cleanup = bracket (liftIO setup) (liftIO . cleanup)
  - ThreadKilled and UserInterrupt get through.
  -}
 catchNonAsync :: MonadCatch m => m a -> (SomeException -> m a) -> m a
-catchNonAsync a onerr = a `catches`
-	[ M.Handler (\ (e :: AsyncException) -> throwM e)
-	, M.Handler (\ (e :: SomeAsyncException) -> throwM e)
-	, M.Handler (\ (e :: SomeException) -> onerr e)
-	]
+catchNonAsync a onerr = a `catches` (nonAsyncHandler onerr)
 
 tryNonAsync :: MonadCatch m => m a -> m (Either SomeException a)
 tryNonAsync a = go `catchNonAsync` (return . Left)
@@ -94,6 +94,13 @@ tryNonAsync a = go `catchNonAsync` (return . Left)
 		v <- a
 		return (Right v)
 
+nonAsyncHandler :: MonadCatch m => (SomeException -> m a) -> [M.Handler m a]
+nonAsyncHandler onerr = 
+	[ M.Handler (\ (e :: AsyncException) -> throwM e)
+	, M.Handler (\ (e :: SomeAsyncException) -> throwM e)
+	, M.Handler (\ (e :: SomeException) -> onerr e)
+	]
+
 {- Catches only DoesNotExist exceptions, and lets all others through. -}
 tryWhenExists :: MonadCatch m => m a -> m (Maybe a)
 tryWhenExists a = do
diff --git a/Utility/FileMode.hs b/Utility/FileMode.hs
index 6725601..ecc19d8 100644
--- a/Utility/FileMode.hs
+++ b/Utility/FileMode.hs
@@ -1,6 +1,6 @@
 {- File mode utilities.
  -
- - Copyright 2010-2020 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2023 Joey Hess <id@joeyh.name>
  -
  - License: BSD-2-clause
  -}
@@ -16,7 +16,10 @@ module Utility.FileMode (
 import System.IO
 import Control.Monad
 import System.PosixCompat.Types
-import System.PosixCompat.Files hiding (removeLink)
+import System.PosixCompat.Files (unionFileModes, intersectFileModes, stdFileMode, nullFileMode, groupReadMode, ownerReadMode, ownerWriteMode, ownerExecuteMode, groupWriteMode, groupExecuteMode, otherReadMode, otherWriteMode, otherExecuteMode, fileMode)
+#ifndef mingw32_HOST_OS
+import System.PosixCompat.Files (setFileCreationMask)
+#endif
 import Control.Monad.IO.Class
 import Foreign (complement)
 import Control.Monad.Catch
@@ -100,16 +103,19 @@ checkMode checkfor mode = checkfor `intersectFileModes` mode == checkfor
 isExecutable :: FileMode -> Bool
 isExecutable mode = combineModes executeModes `intersectFileModes` mode /= 0
 
-{- Runs an action without that pesky umask influencing it, unless the
- - passed FileMode is the standard one. -}
-noUmask :: (MonadIO m, MonadMask m) => FileMode -> m a -> m a
-#ifndef mingw32_HOST_OS
-noUmask mode a
-	| mode == stdFileMode = a
-	| otherwise = withUmask nullFileMode a
-#else
-noUmask _ a = a
-#endif
+data ModeSetter = ModeSetter FileMode (RawFilePath -> IO ())
+
+{- Runs an action which should create the file, passing it the desired
+ - initial file mode. Then runs the ModeSetter's action on the file, which
+ - can adjust the initial mode if umask prevented the file from being
+ - created with the right mode. -}
+applyModeSetter :: Maybe ModeSetter -> RawFilePath -> (Maybe FileMode -> IO a) -> IO a
+applyModeSetter (Just (ModeSetter mode modeaction)) file a = do
+	r <- a (Just mode)
+	void $ tryIO $ modeaction file
+	return r
+applyModeSetter Nothing _ a = 
+	a Nothing
 
 withUmask :: (MonadIO m, MonadMask m) => FileMode -> m a -> m a
 #ifndef mingw32_HOST_OS
@@ -169,10 +175,10 @@ writeFileProtected file content = writeFileProtected' file
 	(\h -> hPutStr h content)
 
 writeFileProtected' :: RawFilePath -> (Handle -> IO ()) -> IO ()
-writeFileProtected' file writer = protectedOutput $
-	withFile (fromRawFilePath file) WriteMode $ \h -> do
-		void $ tryIO $ modifyFileMode file $ removeModes otherGroupModes
-		writer h
+writeFileProtected' file writer = do
+	h <- protectedOutput $ openFile (fromRawFilePath file) WriteMode
+	void $ tryIO $ modifyFileMode file $ removeModes otherGroupModes
+	writer h
 
 protectedOutput :: IO a -> IO a
 protectedOutput = withUmask 0o0077
diff --git a/Utility/FileSize.hs b/Utility/FileSize.hs
index a503fda..3d216f2 100644
--- a/Utility/FileSize.hs
+++ b/Utility/FileSize.hs
@@ -14,13 +14,15 @@ module Utility.FileSize (
 	getFileSize',
 ) where
 
-import System.PosixCompat.Files hiding (removeLink)
-import qualified Utility.RawFilePath as R
 #ifdef mingw32_HOST_OS
 import Control.Exception (bracket)
 import System.IO
 import Utility.FileSystemEncoding
+#else
+import System.PosixCompat.Files (fileSize)
 #endif
+import System.PosixCompat.Files (FileStatus)
+import qualified Utility.RawFilePath as R
 
 type FileSize = Integer
 
diff --git a/Utility/Format.hs b/Utility/Format.hs
index 466988c..930b7ee 100644
--- a/Utility/Format.hs
+++ b/Utility/Format.hs
@@ -1,6 +1,6 @@
 {- Formatted string handling.
  -
- - Copyright 2010-2020 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2023 Joey Hess <id@joeyh.name>
  -
  - License: BSD-2-clause
  -}
@@ -9,10 +9,12 @@ module Utility.Format (
 	Format,
 	gen,
 	format,
+	escapedFormat,
 	formatContainsVar,
 	decode_c,
 	encode_c,
 	encode_c',
+	isUtf8Byte,
 	prop_encode_c_decode_c_roundtrip
 ) where
 
@@ -21,12 +23,11 @@ import Data.Char (isAlphaNum, isOctDigit, isHexDigit, isSpace, chr, ord, isAscii
 import Data.Maybe (fromMaybe)
 import Data.Word (Word8)
 import Data.List (isPrefixOf)
-import qualified Codec.Binary.UTF8.String
 import qualified Data.Map as M
+import qualified Data.ByteString as S
 
 import Utility.PartialPrelude
-
-type FormatString = String
+import Utility.FileSystemEncoding
 
 {- A format consists of a list of fragments. -}
 type Format = [Frag]
@@ -53,7 +54,8 @@ format f vars = concatMap expand f
   where
 	expand (Const s) = s
 	expand (Var name j esc)
-		| esc = justify j $ encode_c' isSpace $ getvar name
+		| esc = justify j $ decodeBS $ escapedFormat $
+			encodeBS $ getvar name
 		| otherwise = justify j $ getvar name
 	getvar name = fromMaybe "" $ M.lookup name vars
 	justify UnJustified s        = s
@@ -62,6 +64,13 @@ format f vars = concatMap expand f
 	pad i s = take (i - length s) spaces
 	spaces = repeat ' '
 
+escapedFormat :: S.ByteString -> S.ByteString
+escapedFormat = encode_c needescape
+  where
+	needescape c = isUtf8Byte c ||
+		isSpace (chr (fromIntegral c)) ||
+		c == fromIntegral (ord '"')
+
 {- Generates a Format that can be used to expand variables in a
  - format string, such as "${foo} ${bar;10} ${baz;-10}\n"
  -
@@ -69,8 +78,8 @@ format f vars = concatMap expand f
  -
  - Also, "${escaped_foo}" will apply encode_c to the value of variable foo.
  -}
-gen :: FormatString -> Format
-gen = filter (not . empty) . fuse [] . scan [] . decode_c
+gen :: String -> Format
+gen = filter (not . empty) . fuse [] . scan [] . decodeBS . decode_c . encodeBS
   where
 	-- The Format is built up in reverse, for efficiency,
 	-- and can have many adjacent Consts. Fusing it fixes both
@@ -122,33 +131,50 @@ formatContainsVar v = any go
 {- Decodes a C-style encoding, where \n is a newline (etc),
  - \NNN is an octal encoded character, and \xNN is a hex encoded character.
  -}
-decode_c :: FormatString -> String
-decode_c [] = []
-decode_c s = unescape ("", s)
+decode_c :: S.ByteString -> S.ByteString
+decode_c s
+	| S.null s = S.empty
+	| otherwise = unescape (S.empty, s)
   where
-	e = '\\'
-	unescape (b, []) = b
-	-- look for escapes starting with '\'
-	unescape (b, v) = b ++ fst pair ++ unescape (handle $ snd pair)
+	e = fromIntegral (ord '\\')
+	x = fromIntegral (ord 'x')
+	isescape c = c == e
+	unescape (b, v)
+		| S.null v = b
+		| otherwise = b <> fst pair <> unescape (handle $ snd pair)
 	  where
-		pair = span (/= e) v
-	isescape x = x == e
-	handle (x:'x':n1:n2:rest)
-		| isescape x && allhex = (fromhex, rest)
+		pair = S.span (not . isescape) v
+	handle b
+		| S.length b >= 1 && isescape (S.index b 0) = handle' b
+		| otherwise = (S.empty, b)
+	
+	handle' b
+		| S.length b >= 4
+			&& S.index b 1 == x
+			&& allhex = (fromhex, rest)
 	  where
+		n1 = chr (fromIntegral (S.index b 2))
+		n2 = chr (fromIntegral (S.index b 3))
+	  	rest = S.drop 4 b
 		allhex = isHexDigit n1 && isHexDigit n2
-		fromhex = [chr $ readhex [n1, n2]]
+		fromhex = encodeBS [chr $ readhex [n1, n2]]
 		readhex h = Prelude.read $ "0x" ++ h :: Int
-	handle (x:n1:n2:n3:rest)
-		| isescape x && alloctal = (fromoctal, rest)
+	handle' b
+		| S.length b >= 4 && alloctal = (fromoctal, rest)
 	  where
+		n1 = chr (fromIntegral (S.index b 1))
+		n2 = chr (fromIntegral (S.index b 2))
+		n3 = chr (fromIntegral (S.index b 3))
+	  	rest = S.drop 4 b
 		alloctal = isOctDigit n1 && isOctDigit n2 && isOctDigit n3
-		fromoctal = [chr $ readoctal [n1, n2, n3]]
+		fromoctal = encodeBS [chr $ readoctal [n1, n2, n3]]
 		readoctal o = Prelude.read $ "0o" ++ o :: Int
-	-- \C is used for a few special characters
-	handle (x:nc:rest)
-		| isescape x = ([echar nc], rest)
+	handle' b
+		| S.length b >= 2 = 
+			(S.singleton (fromIntegral (ord (echar nc))), rest)
 	  where
+		nc = chr (fromIntegral (S.index b 1))
+		rest = S.drop 2 b
 		echar 'a' = '\a'
 		echar 'b' = '\b'
 		echar 'f' = '\f'
@@ -156,38 +182,50 @@ decode_c s = unescape ("", s)
 		echar 'r' = '\r'
 		echar 't' = '\t'
 		echar 'v' = '\v'
-		echar a = a
-	handle n = ("", n)
-
-{- Inverse of decode_c. -}
-encode_c :: String -> FormatString
-encode_c = encode_c' (const False)
+		echar a = a -- \\ decodes to '\', and \" to '"'
+	handle' b = (S.empty, b)
 
-{- Encodes special characters, as well as any matching the predicate. -}
-encode_c' :: (Char -> Bool) -> String -> FormatString
-encode_c' p = concatMap echar
+{- Inverse of decode_c. Encodes ascii control characters as well as
+ - bytes that match the predicate. (And also '\' itself.)
+ -}
+encode_c :: (Word8 -> Bool) -> S.ByteString -> S.ByteString
+encode_c p s = fromMaybe s (encode_c' p s)
+
+{- Returns Nothing when nothing needs to be escaped in the input ByteString. -}
+encode_c' :: (Word8 -> Bool) -> S.ByteString -> Maybe S.ByteString
+encode_c' p s
+	| S.any needencode s = Just (S.concatMap echar s)
+	| otherwise = Nothing
   where
-	e c = '\\' : [c]
-	echar '\a' = e 'a'
-	echar '\b' = e 'b'
-	echar '\f' = e 'f'
-	echar '\n' = e 'n'
-	echar '\r' = e 'r'
-	echar '\t' = e 't'
-	echar '\v' = e 'v'
-	echar '\\' = e '\\'
-	echar '"'  = e '"'
+	e = fromIntegral (ord '\\')
+	q = fromIntegral (ord '"')
+	del = 0x7F
+	iscontrol c = c < 0x20
+
+	echar 0x7 = ec 'a'
+	echar 0x8 = ec 'b'
+	echar 0x0C = ec 'f'
+	echar 0x0A = ec 'n'
+	echar 0x0D = ec 'r'
+	echar 0x09 = ec 't'
+	echar 0x0B = ec 'v'
 	echar c
-		| ord c < 0x20 = e_asc c -- low ascii
-		| ord c >= 256 = e_utf c -- unicode
-		| ord c > 0x7E = e_asc c -- high ascii
-		| p c          = e_asc c
-		| otherwise    = [c]
-	-- unicode character is decomposed to individual Word8s,
-	-- and each is shown in octal
-	e_utf c = showoctal =<< (Codec.Binary.UTF8.String.encode [c] :: [Word8])
-	e_asc c = showoctal $ ord c
-	showoctal i = '\\' : printf "%03o" i
+		| iscontrol c = showoctal c -- other control characters
+		| c == e = ec '\\' -- escape the escape character itself
+		| c == del = showoctal c
+		| p c = if c == q
+			then ec '"' -- escape double quote
+			else showoctal c
+		| otherwise = S.singleton c
+	
+	needencode c = iscontrol c || c == e || c == del || p c
+
+	ec c = S.pack [e, fromIntegral (ord c)]
+
+	showoctal i = encodeBS ('\\' : printf "%03o" i)
+
+isUtf8Byte :: Word8 -> Bool
+isUtf8Byte c = c >= 0x80
 
 {- For quickcheck. 
  -
@@ -198,6 +236,7 @@ encode_c' p = concatMap echar
  - This property papers over the problem, by only testing ascii.
  -}
 prop_encode_c_decode_c_roundtrip :: String -> Bool
-prop_encode_c_decode_c_roundtrip s = s' == decode_c (encode_c s')
+prop_encode_c_decode_c_roundtrip s = s' == 
+	decodeBS (decode_c (encode_c isUtf8Byte (encodeBS s')))
   where
 	s' = filter isAscii s
diff --git a/Utility/InodeCache.hs b/Utility/InodeCache.hs
index b697ab3..3828bc6 100644
--- a/Utility/InodeCache.hs
+++ b/Utility/InodeCache.hs
@@ -32,6 +32,7 @@ module Utility.InodeCache (
 	inodeCacheToMtime,
 	inodeCacheToEpochTime,
 	inodeCacheEpochTimeRange,
+	replaceInode,
 
 	SentinalFile(..),
 	SentinalStatus(..),
@@ -50,11 +51,10 @@ import Utility.QuickCheck
 import qualified Utility.RawFilePath as R
 
 import System.PosixCompat.Types
+import System.PosixCompat.Files (isRegularFile, fileID)
 import Data.Time.Clock.POSIX
 
-#ifdef mingw32_HOST_OS
-import Data.Word (Word64)
-#else
+#ifndef mingw32_HOST_OS
 import qualified System.Posix.Files as Posix
 #endif
 
@@ -125,7 +125,11 @@ inodeCacheEpochTimeRange i =
 	let t = inodeCacheToEpochTime i
 	in (t-1, t+1)
 
-{- For backwards compatability, support low-res mtime with no
+replaceInode :: FileID -> InodeCache -> InodeCache
+replaceInode inode (InodeCache (InodeCachePrim _ sz mtime)) =
+	InodeCache (InodeCachePrim inode sz mtime)
+
+{- For backwards compatibility, support low-res mtime with no
  - fractional seconds. -}
 data MTime = MTimeLowRes EpochTime | MTimeHighRes POSIXTime
 	deriving (Show, Ord)
@@ -187,7 +191,7 @@ readInodeCache s = case words s of
 
 genInodeCache :: RawFilePath -> TSDelta -> IO (Maybe InodeCache)
 genInodeCache f delta = catchDefaultIO Nothing $
-	toInodeCache delta f =<< R.getFileStatus f
+	toInodeCache delta f =<< R.getSymbolicLinkStatus f
 
 toInodeCache :: TSDelta -> RawFilePath -> FileStatus -> IO (Maybe InodeCache)
 toInodeCache d f s = toInodeCache' d f s (fileID s)
@@ -243,7 +247,7 @@ data SentinalStatus = SentinalStatus
  - On Windows, time stamp differences are ignored, since they change
  - with the timezone.
  -
- - When the sential file does not exist, InodeCaches canot reliably be
+ - When the sential file does not exist, InodeCaches cannot reliably be
  - compared, so the assumption is that there is has been a change.
  -}
 checkSentinalFile :: SentinalFile -> IO SentinalStatus
diff --git a/Utility/Metered.hs b/Utility/Metered.hs
index 8fd9c9b..a8a7111 100644
--- a/Utility/Metered.hs
+++ b/Utility/Metered.hs
@@ -53,6 +53,7 @@ import Utility.DataUnits
 import Utility.HumanTime
 import Utility.SimpleProtocol as Proto
 import Utility.ThreadScheduler
+import Utility.SafeOutput
 
 import qualified Data.ByteString.Lazy as L
 import qualified Data.ByteString as S
@@ -321,7 +322,7 @@ demeterCommandEnv oh cmd params environ = do
   where
 	stdouthandler l = 
 		unless (quietMode oh) $
-			putStrLn l
+			putStrLn (safeOutput l)
 
 {- To suppress progress output, while displaying other messages,
  - filter out lines that contain \r (typically used to reset to the
@@ -491,14 +492,14 @@ bandwidthMeter mtotalsize (MeterState (BytesProcessed old) before) (MeterState (
 		, estimatedcompletion
 		]
   where
-	amount = roughSize' memoryUnits True 2 new
+	amount = roughSize' committeeUnits True 2 new
 	percentamount = case mtotalsize of
 		Just (TotalSize totalsize) ->
 			let p = showPercentage 0 $
 				percentage totalsize (min new totalsize)
 			in p ++ replicate (6 - length p) ' ' ++ amount
 		Nothing -> amount
-	rate = roughSize' memoryUnits True 0 bytespersecond ++ "/s"
+	rate = roughSize' committeeUnits True 0 bytespersecond ++ "/s"
 	bytespersecond
 		| duration == 0 = fromIntegral transferred
 		| otherwise = floor $ fromIntegral transferred / duration
diff --git a/Utility/Misc.hs b/Utility/Misc.hs
index 01ae178..3cf5275 100644
--- a/Utility/Misc.hs
+++ b/Utility/Misc.hs
@@ -12,6 +12,7 @@ module Utility.Misc (
 	readFileStrict,
 	separate,
 	separate',
+	separateEnd',
 	firstLine,
 	firstLine',
 	segment,
@@ -62,6 +63,13 @@ separate' c l = unbreak $ S.break c l
 		| S.null b = r
 		| otherwise = (a, S.tail b)
 
+separateEnd' :: (Word8 -> Bool) -> S.ByteString -> (S.ByteString, S.ByteString)
+separateEnd' c l = unbreak $ S.breakEnd c l
+  where
+	unbreak r@(a, b)
+		| S.null a = r
+		| otherwise = (S.init a, b)
+
 {- Breaks out the first line. -}
 firstLine :: String -> String
 firstLine = takeWhile (/= '\n')
@@ -86,7 +94,7 @@ prop_segment_regressionTest :: Bool
 prop_segment_regressionTest = all id
 	-- Even an empty list is a segment.
 	[ segment (== "--") [] == [[]]
-	-- There are two segements in this list, even though the first is empty.
+	-- There are two segments in this list, even though the first is empty.
 	, segment (== "--") ["--", "foo", "bar"] == [[],["foo","bar"]]
 	]
 
diff --git a/Utility/Monad.hs b/Utility/Monad.hs
index abe06f3..6cd2c5e 100644
--- a/Utility/Monad.hs
+++ b/Utility/Monad.hs
@@ -12,6 +12,7 @@ module Utility.Monad (
 	getM,
 	anyM,
 	allM,
+	partitionM,
 	untilTrue,
 	ifM,
 	(<||>),
@@ -45,6 +46,13 @@ allM :: Monad m => (a -> m Bool) -> [a] -> m Bool
 allM _ [] = return True
 allM p (x:xs) = p x <&&> allM p xs
 
+partitionM :: Monad m => (a -> m Bool) -> [a] -> m ([a], [a])
+partitionM _ [] = return ([], [])
+partitionM p (x:xs) = do
+	r <- p x
+	(as, bs) <- partitionM p xs
+	return $ if r then (x:as, bs) else (as, x:bs)
+
 {- Runs an action on values from a list until it succeeds. -}
 untilTrue :: Monad m => [a] -> (a -> m Bool) -> m Bool
 untilTrue = flip anyM
diff --git a/Utility/MoveFile.hs b/Utility/MoveFile.hs
index 3ea17e8..6481b29 100644
--- a/Utility/MoveFile.hs
+++ b/Utility/MoveFile.hs
@@ -14,12 +14,11 @@ module Utility.MoveFile (
 ) where
 
 import Control.Monad
-import System.FilePath
-import System.PosixCompat.Files hiding (removeLink)
 import System.IO.Error
 import Prelude
 
 #ifndef mingw32_HOST_OS
+import System.PosixCompat.Files (isDirectory)
 import Control.Monad.IfElse
 import Utility.SafeCommand
 #endif
@@ -28,17 +27,19 @@ import Utility.SystemDirectory
 import Utility.Tmp
 import Utility.Exception
 import Utility.Monad
+import Utility.FileSystemEncoding
+import qualified Utility.RawFilePath as R
 
 {- Moves one filename to another.
  - First tries a rename, but falls back to moving across devices if needed. -}
-moveFile :: FilePath -> FilePath -> IO ()
-moveFile src dest = tryIO (rename src dest) >>= onrename
+moveFile :: RawFilePath -> RawFilePath -> IO ()
+moveFile src dest = tryIO (R.rename src dest) >>= onrename
   where
 	onrename (Right _) = noop
 	onrename (Left e)
 		| isPermissionError e = rethrow
 		| isDoesNotExistError e = rethrow
-		| otherwise = viaTmp mv dest ()
+		| otherwise = viaTmp mv (fromRawFilePath dest) ()
 	  where
 		rethrow = throwM e
 
@@ -46,16 +47,20 @@ moveFile src dest = tryIO (rename src dest) >>= onrename
 			-- copyFile is likely not as optimised as
 			-- the mv command, so we'll use the command.
 			--
-			-- But, while Windows has a "mv", it does not seem very
-			-- reliable, so use copyFile there.
+			-- But, while Windows has a "mv", it does not
+			-- seem very reliable, so use copyFile there.
 #ifndef mingw32_HOST_OS	
 			-- If dest is a directory, mv would move the file
 			-- into it, which is not desired.
 			whenM (isdir dest) rethrow
-			ok <- boolSystem "mv" [Param "-f", Param src, Param tmp]
+			ok <- boolSystem "mv"
+				[ Param "-f"
+				, Param (fromRawFilePath src)
+				, Param tmp
+				]
 			let e' = e
 #else
-			r <- tryIO $ copyFile src tmp
+			r <- tryIO $ copyFile (fromRawFilePath src) tmp
 			let (ok, e') = case r of
 				Left err -> (False, err)
 				Right _ -> (True, e)
@@ -67,7 +72,7 @@ moveFile src dest = tryIO (rename src dest) >>= onrename
 
 #ifndef mingw32_HOST_OS	
 	isdir f = do
-		r <- tryIO $ getFileStatus f
+		r <- tryIO $ R.getSymbolicLinkStatus f
 		case r of
 			(Left _) -> return False
 			(Right s) -> return $ isDirectory s
diff --git a/Utility/Path.hs b/Utility/Path.hs
index b5aeb16..64ef076 100644
--- a/Utility/Path.hs
+++ b/Utility/Path.hs
@@ -20,6 +20,7 @@ module Utility.Path (
 	runSegmentPaths',
 	dotfile,
 	splitShortExtensions,
+	splitShortExtensions',
 	relPathDirToFileAbs,
 	inSearchPath,
 	searchPath,
@@ -53,7 +54,7 @@ import Utility.FileSystemEncoding
  -
  - This does not guarantee that two paths that refer to the same location,
  - and are both relative to the same location (or both absolute) will
- - yeild the same result. Run both through normalise from System.RawFilePath
+ - yield the same result. Run both through normalise from System.RawFilePath
  - to ensure that.
  -}
 simplifyPath :: RawFilePath -> RawFilePath
@@ -90,7 +91,7 @@ upFrom dir
 
 {- Checks if the first RawFilePath is, or could be said to contain the second.
  - For example, "foo/" contains "foo/bar". Also, "foo", "./foo", "foo/" etc
- - are all equivilant.
+ - are all equivalent.
  -}
 dirContains :: RawFilePath -> RawFilePath -> Bool
 dirContains a b = a == b
diff --git a/Utility/Path/AbsRel.hs b/Utility/Path/AbsRel.hs
index 857dd5e..4007fbb 100644
--- a/Utility/Path/AbsRel.hs
+++ b/Utility/Path/AbsRel.hs
@@ -37,7 +37,7 @@ import Utility.FileSystemEncoding
  - Also simplifies it using simplifyPath.
  -
  - The first parameter is a base directory (ie, the cwd) to use if the path
- - is not already absolute, and should itsef be absolute.
+ - is not already absolute, and should itself be absolute.
  -
  - Does not attempt to deal with edge cases or ensure security with
  - untrusted inputs.
diff --git a/Utility/Process.hs b/Utility/Process.hs
index 4cf6105..07f035d 100644
--- a/Utility/Process.hs
+++ b/Utility/Process.hs
@@ -31,6 +31,7 @@ module Utility.Process (
 	stdoutHandle,
 	stderrHandle,
 	processHandle,
+	showCmd,
 	devNull,
 ) where
 
@@ -188,11 +189,13 @@ withCreateProcess p action = bracket (createProcess p) cleanupProcess
 debugProcess :: CreateProcess -> ProcessHandle -> IO ()
 debugProcess p h = do
 	pid <- getPid h
-	debug "Utility.Process" $ unwords
+	debug "Utility.Process" $ unwords $
 		[ describePid pid
 		, action ++ ":"
 		, showCmd p
-		]
+		] ++ case cwd p of
+			Nothing -> []
+			Just c -> ["in", show c]
   where
 	action
 		| piped (std_in p) && piped (std_out p) = "chat"
diff --git a/Utility/Process/Transcript.hs b/Utility/Process/Transcript.hs
new file mode 100644
index 0000000..7bf94ff
--- /dev/null
+++ b/Utility/Process/Transcript.hs
@@ -0,0 +1,97 @@
+{- Process transcript
+ -
+ - Copyright 2012-2020 Joey Hess <id@joeyh.name>
+ -
+ - License: BSD-2-clause
+ -}
+
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
+
+module Utility.Process.Transcript (
+	processTranscript,
+	processTranscript',
+	processTranscript'',
+) where
+
+import Utility.Process
+
+import System.IO
+import System.Exit
+import Control.Concurrent.Async
+import Control.Monad
+#ifndef mingw32_HOST_OS
+import Control.Exception
+import qualified System.Posix.IO
+#else
+import Control.Applicative
+#endif
+import Data.Maybe
+import Prelude
+
+-- | Runs a process and returns a transcript combining its stdout and
+-- stderr, and whether it succeeded or failed.
+processTranscript :: String -> [String] -> (Maybe String) -> IO (String, Bool)
+processTranscript cmd opts = processTranscript' (proc cmd opts)
+
+-- | Also feeds the process some input.
+processTranscript' :: CreateProcess -> Maybe String -> IO (String, Bool)
+processTranscript' cp input = do
+	(t, c) <- processTranscript'' cp input
+	return (t, c == ExitSuccess)
+
+processTranscript'' :: CreateProcess -> Maybe String -> IO (String, ExitCode)
+processTranscript'' cp input = do
+#ifndef mingw32_HOST_OS
+{- This implementation interleves stdout and stderr in exactly the order
+ - the process writes them. -}
+ 	let setup = do
+		(readf, writef) <- System.Posix.IO.createPipe
+		System.Posix.IO.setFdOption readf System.Posix.IO.CloseOnExec True
+		System.Posix.IO.setFdOption writef System.Posix.IO.CloseOnExec True
+		readh <- System.Posix.IO.fdToHandle readf
+		writeh <- System.Posix.IO.fdToHandle writef
+		return (readh, writeh)
+	let cleanup (readh, writeh) = do
+		hClose readh
+		hClose writeh
+	bracket setup cleanup $ \(readh, writeh) -> do
+		let cp' = cp
+			{ std_in = if isJust input then CreatePipe else Inherit
+			, std_out = UseHandle writeh
+			, std_err = UseHandle writeh
+			}
+		withCreateProcess cp' $ \hin hout herr pid -> do
+			get <- asyncreader pid readh
+			writeinput input (hin, hout, herr, pid)
+			code <- waitForProcess pid
+			transcript <- wait get
+			return (transcript, code)
+#else
+{- This implementation for Windows puts stderr after stdout. -}
+	let cp' = cp 
+		{ std_in = if isJust input then CreatePipe else Inherit
+		, std_out = CreatePipe
+		, std_err = CreatePipe
+		}
+	withCreateProcess cp' $ \hin hout herr pid -> do
+		let p = (hin, hout, herr, pid)
+		getout <- asyncreader pid (stdoutHandle p)
+		geterr <- asyncreader pid (stderrHandle p)
+		writeinput input p
+		code <- waitForProcess pid
+		transcript <- (++) <$> wait getout <*> wait geterr
+		return (transcript, code)
+#endif
+  where
+	asyncreader pid h = async $ reader pid h []
+	reader pid h c = hGetLineUntilExitOrEOF pid h >>= \case
+		Nothing -> return (unlines (reverse c))
+		Just l -> reader pid h (l:c)
+	writeinput (Just s) p = do
+		let inh = stdinHandle p
+		unless (null s) $ do
+			hPutStr inh s
+			hFlush inh
+		hClose inh
+	writeinput Nothing _ = return ()
diff --git a/Utility/QuickCheck.hs b/Utility/QuickCheck.hs
index 650f559..96e31d5 100644
--- a/Utility/QuickCheck.hs
+++ b/Utility/QuickCheck.hs
@@ -6,6 +6,7 @@
  -}
 
 {-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
 module Utility.QuickCheck
diff --git a/Utility/RawFilePath.hs b/Utility/RawFilePath.hs
index f32b226..b39423d 100644
--- a/Utility/RawFilePath.hs
+++ b/Utility/RawFilePath.hs
@@ -5,9 +5,11 @@
  -
  - On Windows, filenames are in unicode, so RawFilePaths have to be
  - decoded. So this library will work, but less efficiently than using
- - FilePath would.
+ - FilePath would. However, this library also takes care to support long
+ - filenames on Windows, by either using other libraries that do, or by
+ - doing UNC-style conversion itself.
  -
- - Copyright 2019-2020 Joey Hess <id@joeyh.name>
+ - Copyright 2019-2023 Joey Hess <id@joeyh.name>
  -
  - License: BSD-2-clause
  -}
@@ -27,6 +29,10 @@ module Utility.RawFilePath (
 	getCurrentDirectory,
 	createDirectory,
 	setFileMode,
+	setOwnerAndGroup,
+	rename,
+	createNamedPipe,
+	fileAccess,
 ) where
 
 #ifndef mingw32_HOST_OS
@@ -47,23 +53,28 @@ createDirectory p = D.createDirectory p 0o777
 
 #else
 import System.PosixCompat (FileStatus, FileMode)
+-- System.PosixCompat does not handle UNC-style conversion itself,
+-- so all uses of it library have to be pre-converted below. See
+-- https://github.com/jacobstanley/unix-compat/issues/56
 import qualified System.PosixCompat as P
-import qualified System.PosixCompat.Files as F
 import qualified System.Directory as D
 import Utility.FileSystemEncoding
+import Utility.Path.Windows
 
 readSymbolicLink :: RawFilePath -> IO RawFilePath
 readSymbolicLink f = toRawFilePath <$> P.readSymbolicLink (fromRawFilePath f)
 
 createSymbolicLink :: RawFilePath -> RawFilePath -> IO ()
-createSymbolicLink a b = P.createSymbolicLink
-	(fromRawFilePath a)
-	(fromRawFilePath b)
+createSymbolicLink a b = do
+	a' <- fromRawFilePath <$> convertToWindowsNativeNamespace a
+	b' <- fromRawFilePath <$> convertToWindowsNativeNamespace b
+	P.createSymbolicLink a' b'
 
 createLink :: RawFilePath -> RawFilePath -> IO ()
-createLink a b = P.createLink
-	(fromRawFilePath a)
-	(fromRawFilePath b)
+createLink a b = do
+	a' <- fromRawFilePath <$> convertToWindowsNativeNamespace a
+	b' <- fromRawFilePath <$> convertToWindowsNativeNamespace b
+	P.createLink a' b'
 
 {- On windows, removeLink is not available, so only remove files,
  - not symbolic links. -}
@@ -71,10 +82,12 @@ removeLink :: RawFilePath -> IO ()
 removeLink = D.removeFile . fromRawFilePath
 
 getFileStatus :: RawFilePath -> IO FileStatus
-getFileStatus = P.getFileStatus . fromRawFilePath
+getFileStatus p = P.getFileStatus . fromRawFilePath
+	=<< convertToWindowsNativeNamespace p
 
 getSymbolicLinkStatus :: RawFilePath -> IO FileStatus
-getSymbolicLinkStatus = P.getSymbolicLinkStatus . fromRawFilePath
+getSymbolicLinkStatus p = P.getSymbolicLinkStatus . fromRawFilePath
+	=<< convertToWindowsNativeNamespace p
 
 doesPathExist :: RawFilePath -> IO Bool
 doesPathExist = D.doesPathExist . fromRawFilePath
@@ -86,5 +99,27 @@ createDirectory :: RawFilePath -> IO ()
 createDirectory = D.createDirectory . fromRawFilePath
 
 setFileMode :: RawFilePath -> FileMode -> IO () 
-setFileMode = F.setFileMode . fromRawFilePath
+setFileMode p m = do
+	p' <- fromRawFilePath <$> convertToWindowsNativeNamespace p
+	P.setFileMode p' m
+
+{- Using renamePath rather than the rename provided in unix-compat
+ - because of this bug https://github.com/jacobstanley/unix-compat/issues/56-}
+rename :: RawFilePath -> RawFilePath -> IO ()
+rename a b = D.renamePath (fromRawFilePath a) (fromRawFilePath b)
+
+setOwnerAndGroup :: RawFilePath -> P.UserID -> P.GroupID -> IO ()
+setOwnerAndGroup p u g = do
+	p' <- fromRawFilePath <$> convertToWindowsNativeNamespace p
+	P.setOwnerAndGroup p' u g
+
+createNamedPipe :: RawFilePath -> FileMode -> IO ()
+createNamedPipe p m = do
+	p' <- fromRawFilePath <$> convertToWindowsNativeNamespace p
+	P.createNamedPipe p' m
+
+fileAccess :: RawFilePath -> Bool -> Bool -> Bool -> IO Bool
+fileAccess p a b c = do
+	p' <- fromRawFilePath <$> convertToWindowsNativeNamespace p
+	P.fileAccess p' a b c
 #endif
diff --git a/Utility/SafeOutput.hs b/Utility/SafeOutput.hs
new file mode 100644
index 0000000..d781386
--- /dev/null
+++ b/Utility/SafeOutput.hs
@@ -0,0 +1,36 @@
+{- Safe output to the terminal of possibly attacker-controlled strings,
+ - avoiding displaying control characters.
+ -
+ - Copyright 2023 Joey Hess <id@joeyh.name>
+ -
+ - License: BSD-2-clause
+ -}
+
+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
+
+module Utility.SafeOutput (
+	safeOutput,
+	safeOutputChar,
+) where
+
+import Data.Char
+import qualified Data.ByteString as S
+
+class SafeOutputtable t where
+	safeOutput :: t -> t
+
+instance SafeOutputtable String where
+	safeOutput = filter safeOutputChar
+
+instance SafeOutputtable S.ByteString where
+	safeOutput = S.filter (safeOutputChar . chr . fromIntegral)
+
+safeOutputChar :: Char -> Bool
+safeOutputChar c
+	| not (isControl c) = True
+	| c == '\n' = True
+	| c == '\t' = True
+	| c == '\DEL' = False
+	| ord c > 31 = True
+	| otherwise = False
diff --git a/Utility/SystemDirectory.hs b/Utility/SystemDirectory.hs
index b9040fe..a7d60f9 100644
--- a/Utility/SystemDirectory.hs
+++ b/Utility/SystemDirectory.hs
@@ -1,4 +1,4 @@
-{- System.Directory without its conflicting isSymbolicLink
+{- System.Directory without its conflicting isSymbolicLink and getFileSize.
  -
  - Copyright 2016 Joey Hess <id@joeyh.name>
  -
diff --git a/Utility/Tmp.hs b/Utility/Tmp.hs
index 92bd921..efb15bd 100644
--- a/Utility/Tmp.hs
+++ b/Utility/Tmp.hs
@@ -21,12 +21,12 @@ import System.IO
 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
 import Utility.FileMode
+import qualified Utility.RawFilePath as R
 
 type Template = String
 
@@ -62,14 +62,15 @@ viaTmp a file content = bracketIO setup cleanup use
 		_ <- tryIO $ hClose h
 		tryIO $ removeFile tmpfile
 	use (tmpfile, h) = do
+		let tmpfile' = toRawFilePath tmpfile
 		-- Make mode the same as if the file were created usually,
 		-- not as a temp file. (This may fail on some filesystems
 		-- that don't support file modes well, so ignore
 		-- exceptions.)
-		_ <- liftIO $ tryIO $ setFileMode tmpfile =<< defaultFileMode
+		_ <- liftIO $ tryIO $ R.setFileMode tmpfile' =<< defaultFileMode
 		liftIO $ hClose h
 		a tmpfile content
-		liftIO $ rename tmpfile file
+		liftIO $ R.rename tmpfile' (toRawFilePath file)
 
 {- Runs an action with a tmp file located in the system's tmp directory
  - (or in "." if there is none) then removes the file. -}
diff --git a/Utility/Url/Parse.hs b/Utility/Url/Parse.hs
new file mode 100644
index 0000000..7fc952b
--- /dev/null
+++ b/Utility/Url/Parse.hs
@@ -0,0 +1,63 @@
+{- Url parsing.
+ -
+ - Copyright 2011-2023 Joey Hess <id@joeyh.name>
+ -
+ - License: BSD-2-clause
+ -}
+
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP #-}
+
+module Utility.Url.Parse (
+	parseURIPortable,
+	parseURIRelaxed,
+) where
+
+import Network.URI
+#ifdef mingw32_HOST_OS
+import qualified System.FilePath.Windows as PW
+#endif
+
+{- On unix this is the same as parseURI. But on Windows,
+ - it can parse urls such as file:///C:/path/to/file
+ - parseURI normally parses that as a path /C:/path/to/file
+ - and this simply removes the excess leading slash when there is a
+ - drive letter after it. -}
+parseURIPortable :: String -> Maybe URI
+#ifndef mingw32_HOST_OS
+parseURIPortable = parseURI
+#else
+parseURIPortable s
+	| "file:" `isPrefixOf` s = do
+		u <- parseURI s
+		return $ case PW.splitDirectories (uriPath u) of
+			(p:d:_) | all PW.isPathSeparator p && PW.isDrive d ->
+				u { uriPath = dropWhile PW.isPathSeparator (uriPath u) }
+			_ -> u
+	| otherwise = parseURI s
+#endif
+
+{- Allows for spaces and other stuff in urls, properly escaping them. -}
+parseURIRelaxed :: String -> Maybe URI
+parseURIRelaxed s = maybe (parseURIRelaxed' s) Just $
+	parseURIPortable $ escapeURIString isAllowedInURI s
+
+{- Some characters like '[' are allowed in eg, the address of
+ - an uri, but cannot appear unescaped further along in the uri.
+ - This handles that, expensively, by successively escaping each character
+ - from the back of the url until the url parses.
+ -}
+parseURIRelaxed' :: String -> Maybe URI
+parseURIRelaxed' s = go [] (reverse s)
+  where
+	go back [] = parseURI back
+	go back (c:cs) = case parseURI (escapeURIString isAllowedInURI (reverse (c:cs)) ++ back) of
+		Just u -> Just u
+		Nothing -> go (escapeURIChar escapemore c ++ back) cs
+
+	escapemore '[' = False
+	escapemore ']' = False
+	escapemore c = isAllowedInURI c
diff --git a/Utility/UserInfo.hs b/Utility/UserInfo.hs
index 17ce8db..827229d 100644
--- a/Utility/UserInfo.hs
+++ b/Utility/UserInfo.hs
@@ -19,31 +19,32 @@ import Utility.Exception
 #ifndef mingw32_HOST_OS
 import Utility.Data
 import Control.Applicative
+import System.Posix.User
+#if MIN_VERSION_unix(2,8,0)
+import System.Posix.User.ByteString (UserEntry)
+#endif
 #endif
 
-import System.PosixCompat
 import Prelude
 
 {- Current user's home directory.
  -
  - getpwent will fail on LDAP or NIS, so use HOME if set. -}
 myHomeDir :: IO FilePath
-myHomeDir = either giveup return =<< myVal env homeDirectory
-  where
+myHomeDir = either giveup return =<<
 #ifndef mingw32_HOST_OS
-	env = ["HOME"]
+	myVal ["HOME"] homeDirectory
 #else
-	env = ["USERPROFILE", "HOME"] -- HOME is used in Cygwin
+	myVal ["USERPROFILE", "HOME"] -- HOME is used in Cygwin
 #endif
 
 {- Current user's user name. -}
 myUserName :: IO (Either String String)
-myUserName = myVal env userName
-  where
+myUserName =
 #ifndef mingw32_HOST_OS
-	env = ["USER", "LOGNAME"]
+	myVal ["USER", "LOGNAME"] userName
 #else
-	env = ["USERNAME", "USER", "LOGNAME"]
+	myVal ["USERNAME", "USER", "LOGNAME"]
 #endif
 
 myUserGecos :: IO (Maybe String)
@@ -54,16 +55,20 @@ myUserGecos = return Nothing
 myUserGecos = eitherToMaybe <$> myVal [] userGecos
 #endif
 
+#ifndef mingw32_HOST_OS
 myVal :: [String] -> (UserEntry -> String) -> IO (Either String String)
 myVal envvars extract = go envvars
   where
 	go [] = either (const $ envnotset) (Right . extract) <$> get
 	go (v:vs) = maybe (go vs) (return . Right) =<< getEnv v
-#ifndef mingw32_HOST_OS
 	-- This may throw an exception if the system doesn't have a
 	-- passwd file etc; don't let it crash.
 	get = tryNonAsync $ getUserEntryForID =<< getEffectiveUserID
 #else
-	get = return envnotset
+myVal :: [String] -> IO (Either String String)
+myVal envvars = go envvars
+  where
+	go [] = return envnotset
+	go (v:vs) = maybe (go vs) (return . Right) =<< getEnv v
 #endif
 	envnotset = Left ("environment not set: " ++ show envvars)
-- 
cgit v1.2.3