Merge from git-annex.

23 files changed, 980 insertions, 681 deletions

diff --git a/Utility/Batch.hs b/Utility/Batch.hs
index 1d66881..58e326e 100644
--- a/Utility/Batch.hs
+++ b/Utility/Batch.hs
@@ -1,6 +1,6 @@
 {- Running a long or expensive batch operation niced.
  -
- - Copyright 2013 Joey Hess <id@joeyh.name>
+ - Copyright 2013-2020 Joey Hess <id@joeyh.name>
  -
  - License: BSD-2-clause
  -}
@@ -10,6 +10,7 @@
 module Utility.Batch (
 	batch,
 	BatchCommandMaker,
+	nonBatchCommandMaker,
 	getBatchCommandMaker,
 	toBatchCommand,
 	batchCommand,
@@ -22,7 +23,6 @@ import Common
 import Control.Concurrent.Async
 import System.Posix.Process
 #endif
-import qualified Control.Exception as E
 
 {- Runs an operation, at batch priority.
  -
@@ -42,17 +42,18 @@ batch a = wait =<< batchthread
 	batchthread = asyncBound $ do
 		setProcessPriority 0 maxNice
 		a
+	maxNice = 19
 #else
 batch a = a
 #endif
 
-maxNice :: Int
-maxNice = 19
-
 {- Makes a command be run by whichever of nice, ionice, and nocache
  - are available in the path. -}
 type BatchCommandMaker = (String, [CommandParam]) -> (String, [CommandParam])
 
+nonBatchCommandMaker :: BatchCommandMaker
+nonBatchCommandMaker = id
+
 getBatchCommandMaker :: IO BatchCommandMaker
 getBatchCommandMaker = do
 #ifndef mingw32_HOST_OS
@@ -75,11 +76,7 @@ toBatchCommand v = do
 	return $ batchmaker v
 
 {- Runs a command in a way that's suitable for batch jobs that can be
- - interrupted.
- -
- - If the calling thread receives an async exception, it sends the
- - command a SIGTERM, and after the command finishes shuttting down,
- - it re-raises the async exception. -}
+ - interrupted. -}
 batchCommand :: String -> [CommandParam] -> IO Bool
 batchCommand command params = batchCommandEnv command params Nothing
 
@@ -87,13 +84,4 @@ batchCommandEnv :: String -> [CommandParam] -> Maybe [(String, String)] -> IO Bo
 batchCommandEnv command params environ = do
 	batchmaker <- getBatchCommandMaker
 	let (command', params') = batchmaker (command, params)
-	let p = proc command' $ toCommand params'
-	(_, _, _, pid) <- createProcess $ p { env = environ }
-	r <- E.try (waitForProcess pid) :: IO (Either E.SomeException ExitCode)
-	case r of
-		Right ExitSuccess -> return True
-		Right _ -> return False
-		Left asyncexception -> do
-			terminateProcess pid
-			void $ waitForProcess pid
-			E.throwIO asyncexception
+	boolSystemEnv command' params' environ
diff --git a/Utility/Directory.hs b/Utility/Directory.hs
index 8b5b88b..38adf17 100644
--- a/Utility/Directory.hs
+++ b/Utility/Directory.hs
@@ -16,26 +16,16 @@ module Utility.Directory (
 
 import Control.Monad
 import System.FilePath
-import System.PosixCompat.Files
+import System.PosixCompat.Files hiding (removeLink)
 import Control.Applicative
-import Control.Monad.IO.Class
-import Control.Monad.IfElse
 import System.IO.Unsafe (unsafeInterleaveIO)
-import System.IO.Error
 import Data.Maybe
 import Prelude
 
-#ifndef mingw32_HOST_OS
-import Utility.SafeCommand
-#endif
-
 import Utility.SystemDirectory
-import Utility.Path
-import Utility.Tmp
 import Utility.Exception
 import Utility.Monad
 import Utility.Applicative
-import Utility.PartialPrelude
 
 dirCruft :: FilePath -> Bool
 dirCruft "." = True
@@ -101,131 +91,9 @@ dirTreeRecursiveSkipping skipdir topdir = go [] [topdir]
 				=<< catchDefaultIO [] (dirContents dir)
 			go (subdirs++dir:c) dirs
 
-{- 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
-  where
-	onrename (Right _) = noop
-	onrename (Left e)
-		| isPermissionError e = rethrow
-		| isDoesNotExistError e = rethrow
-		| otherwise = viaTmp mv dest ""
-	  where
-		rethrow = throwM e
-
-		mv tmp _ = do
-		-- 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.
-#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]
-			let e' = e
-#else
-			r <- tryIO $ copyFile src tmp
-			let (ok, e') = case r of
-				Left err -> (False, err)
-				Right _ -> (True, e)
-#endif
-			unless ok $ do
-				-- delete any partial
-				_ <- tryIO $ removeFile tmp
-				throwM e'
-
-#ifndef mingw32_HOST_OS	
-	isdir f = do
-		r <- tryIO $ getFileStatus f
-		case r of
-			(Left _) -> return False
-			(Right s) -> return $ isDirectory s
-#endif
-
-{- Removes a file, which may or may not exist, and does not have to
- - be a regular file.
- -
- - Note that an exception is thrown if the file exists but
- - cannot be removed. -}
-nukeFile :: FilePath -> IO ()
-nukeFile file = void $ tryWhenExists go
-  where
-#ifndef mingw32_HOST_OS
-	go = removeLink file
-#else
-	go = removeFile file
-#endif
-
-{- Like createDirectoryIfMissing True, but it will only create
- - missing parent directories up to but not including the directory
- - in the first parameter.
+{- Use with an action that removes something, which may or may not exist.
  -
- - 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.
- -
- - The exception thrown is the same that createDirectory throws if the
- - parent directory does not exist.
- -
- - If the second FilePath is not under the first
- - 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.
- - 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.
+ - If an exception is thrown due to it not existing, it is ignored.
  -}
-createDirectoryUnder :: FilePath -> FilePath -> IO ()
-createDirectoryUnder topdir dir =
-	createDirectoryUnder' topdir dir createDirectory
-
-createDirectoryUnder'
-	:: (MonadIO m, MonadCatch m)
-	=> FilePath
-	-> FilePath
-	-> (FilePath -> m ())
-	-> m ()
-createDirectoryUnder' topdir dir0 mkdir = do
-	p <- liftIO $ relPathDirToFile topdir dir0
-	let dirs = splitDirectories p
-	-- Catch cases where the dir is not beneath the 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 ".." || isAbsolute p
-		then liftIO $ ioError $ customerror userErrorType
-			("createDirectoryFrom: not located in " ++ 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 topdir) $
-				ioError $ customerror doesNotExistErrorType
-					"createDirectoryFrom: does not exist"
-			else createdirs $
-				map (topdir </>) (reverse (scanl1 (</>) dirs))
-  where
-	customerror t s = mkIOError t s Nothing (Just dir0)
-
-	createdirs [] = pure ()
-	createdirs (dir:[]) = createdir dir (liftIO . ioError)
-	createdirs (dir:dirs) = createdir dir $ \_ -> do
-		createdirs dirs
-		createdir dir (liftIO . ioError)
-
-	-- This is the same method used by createDirectoryIfMissing,
-	-- in particular the handling of errors that occur when the
-	-- directory already exists. See its source for explanation
-	-- of several subtleties.
-	createdir dir notexisthandler = tryIO (mkdir dir) >>= \case
-		Right () -> pure ()
-		Left e
-			| isDoesNotExistError e -> notexisthandler e
-			| isAlreadyExistsError e || isPermissionError e ->
-				liftIO $ unlessM (doesDirectoryExist dir) $
-					ioError e
-			| otherwise -> liftIO $ ioError e
+removeWhenExistsWith :: (a -> IO ()) -> a -> IO ()
+removeWhenExistsWith f a = void $ tryWhenExists $ f a
diff --git a/Utility/Directory/Create.hs b/Utility/Directory/Create.hs
new file mode 100644
index 0000000..32c0bcf
--- /dev/null
+++ b/Utility/Directory/Create.hs
@@ -0,0 +1,102 @@
+{- directory creating
+ -
+ - Copyright 2011-2020 Joey Hess <id@joeyh.name>
+ -
+ - License: BSD-2-clause
+ -}
+
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE LambdaCase #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
+
+module Utility.Directory.Create (
+	createDirectoryUnder,
+	createDirectoryUnder',
+) where
+
+import Control.Monad
+import Control.Applicative
+import Control.Monad.IO.Class
+import Control.Monad.IfElse
+import System.IO.Error
+import Data.Maybe
+import qualified System.FilePath.ByteString as P
+import Prelude
+
+import Utility.SystemDirectory
+import Utility.Path.AbsRel
+import Utility.Exception
+import Utility.FileSystemEncoding
+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.
+ -
+ - 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.
+ -
+ - The exception thrown is the same that createDirectory throws if the
+ - parent directory does not exist.
+ -
+ - If the second FilePath is not under the first
+ - 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.
+ - 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.
+ -}
+createDirectoryUnder :: RawFilePath -> RawFilePath -> IO ()
+createDirectoryUnder topdir dir =
+	createDirectoryUnder' topdir dir R.createDirectory
+
+createDirectoryUnder'
+	:: (MonadIO m, MonadCatch m)
+	=> 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.
+	-- 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))
+  where
+	customerror t s = mkIOError t s Nothing (Just (fromRawFilePath dir0))
+
+	createdirs [] = pure ()
+	createdirs (dir:[]) = createdir dir (liftIO . ioError)
+	createdirs (dir:dirs) = createdir dir $ \_ -> do
+		createdirs dirs
+		createdir dir (liftIO . ioError)
+
+	-- This is the same method used by createDirectoryIfMissing,
+	-- in particular the handling of errors that occur when the
+	-- directory already exists. See its source for explanation
+	-- of several subtleties.
+	createdir dir notexisthandler = tryIO (mkdir dir) >>= \case
+		Right () -> pure ()
+		Left e
+			| isDoesNotExistError e -> notexisthandler e
+			| isAlreadyExistsError e || isPermissionError e ->
+				liftIO $ unlessM (doesDirectoryExist (fromRawFilePath dir)) $
+					ioError e
+			| otherwise -> liftIO $ ioError e
diff --git a/Utility/DottedVersion.hs b/Utility/DottedVersion.hs
index dff3717..84b8463 100644
--- a/Utility/DottedVersion.hs
+++ b/Utility/DottedVersion.hs
@@ -13,7 +13,7 @@ module Utility.DottedVersion (
 	normalize,
 ) where
 
-import Common
+import Utility.Split
 
 data DottedVersion = DottedVersion String Integer
 	deriving (Eq)
diff --git a/Utility/Env/Set.hs b/Utility/Env/Set.hs
index f14674c..45d2e7f 100644
--- a/Utility/Env/Set.hs
+++ b/Utility/Env/Set.hs
@@ -10,6 +10,7 @@
 module Utility.Env.Set (
 	setEnv,
 	unsetEnv,
+	legalInEnvVar,
 ) where
 
 #ifdef mingw32_HOST_OS
@@ -18,6 +19,7 @@ import Utility.Env
 #else
 import qualified System.Posix.Env as PE
 #endif
+import Data.Char
 
 {- Sets an environment variable. To overwrite an existing variable,
  - overwrite must be True.
@@ -41,3 +43,7 @@ unsetEnv = PE.unsetEnv
 #else
 unsetEnv = System.SetEnv.unsetEnv
 #endif
+
+legalInEnvVar :: Char -> Bool
+legalInEnvVar '_' = True
+legalInEnvVar c = isAsciiLower c || isAsciiUpper c || (isNumber c && isAscii c)
diff --git a/Utility/Exception.hs b/Utility/Exception.hs
index bcadb78..273f844 100644
--- a/Utility/Exception.hs
+++ b/Utility/Exception.hs
@@ -39,7 +39,7 @@ import Utility.Data
 
 {- 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 excpected to see in some
+ - where there's a problem that the user is expeected to see in some
  - circumstances. -}
 giveup :: [Char] -> a
 giveup = errorWithoutStackTrace
diff --git a/Utility/FileMode.hs b/Utility/FileMode.hs
index 7d36c55..6725601 100644
--- a/Utility/FileMode.hs
+++ b/Utility/FileMode.hs
@@ -1,11 +1,12 @@
 {- File mode utilities.
  -
- - Copyright 2010-2017 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2020 Joey Hess <id@joeyh.name>
  -
  - License: BSD-2-clause
  -}
 
 {-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 
 module Utility.FileMode (
 	module Utility.FileMode,
@@ -15,32 +16,30 @@ module Utility.FileMode (
 import System.IO
 import Control.Monad
 import System.PosixCompat.Types
-import System.PosixCompat.Files
-#ifndef mingw32_HOST_OS
-import System.Posix.Files (symbolicLinkMode)
-import Control.Monad.IO.Class (liftIO)
-#endif
-import Control.Monad.IO.Class (MonadIO)
+import System.PosixCompat.Files hiding (removeLink)
+import Control.Monad.IO.Class
 import Foreign (complement)
 import Control.Monad.Catch
 
 import Utility.Exception
+import Utility.FileSystemEncoding
+import qualified Utility.RawFilePath as R
 
 {- Applies a conversion function to a file's mode. -}
-modifyFileMode :: FilePath -> (FileMode -> FileMode) -> IO ()
+modifyFileMode :: RawFilePath -> (FileMode -> FileMode) -> IO ()
 modifyFileMode f convert = void $ modifyFileMode' f convert
 
-modifyFileMode' :: FilePath -> (FileMode -> FileMode) -> IO FileMode
+modifyFileMode' :: RawFilePath -> (FileMode -> FileMode) -> IO FileMode
 modifyFileMode' f convert = do
-	s <- getFileStatus f
+	s <- R.getFileStatus f
 	let old = fileMode s
 	let new = convert old
 	when (new /= old) $
-		setFileMode f new
+		R.setFileMode f new
 	return old
 
 {- Runs an action after changing a file's mode, then restores the old mode. -}
-withModifiedFileMode :: FilePath -> (FileMode -> FileMode) -> IO a -> IO a
+withModifiedFileMode :: RawFilePath -> (FileMode -> FileMode) -> IO a -> IO a
 withModifiedFileMode file convert a = bracket setup cleanup go
   where
 	setup = modifyFileMode' file convert
@@ -73,15 +72,15 @@ otherGroupModes =
 	]
 
 {- Removes the write bits from a file. -}
-preventWrite :: FilePath -> IO ()
+preventWrite :: RawFilePath -> IO ()
 preventWrite f = modifyFileMode f $ removeModes writeModes
 
 {- Turns a file's owner write bit back on. -}
-allowWrite :: FilePath -> IO ()
+allowWrite :: RawFilePath -> IO ()
 allowWrite f = modifyFileMode f $ addModes [ownerWriteMode]
 
 {- Turns a file's owner read bit back on. -}
-allowRead :: FilePath -> IO ()
+allowRead :: RawFilePath -> IO ()
 allowRead f = modifyFileMode f $ addModes [ownerReadMode]
 
 {- Allows owner and group to read and write to a file. -}
@@ -91,20 +90,12 @@ groupSharedModes =
 	, ownerReadMode, groupReadMode
 	]
 
-groupWriteRead :: FilePath -> IO ()
+groupWriteRead :: RawFilePath -> IO ()
 groupWriteRead f = modifyFileMode f $ addModes groupSharedModes
 
 checkMode :: FileMode -> FileMode -> Bool
 checkMode checkfor mode = checkfor `intersectFileModes` mode == checkfor
 
-{- Checks if a file mode indicates it's a symlink. -}
-isSymLink :: FileMode -> Bool
-#ifdef mingw32_HOST_OS
-isSymLink _ = False
-#else
-isSymLink = checkMode symbolicLinkMode
-#endif
-
 {- Checks if a file has any executable bits set. -}
 isExecutable :: FileMode -> Bool
 isExecutable mode = combineModes executeModes `intersectFileModes` mode /= 0
@@ -160,7 +151,7 @@ isSticky = checkMode stickyMode
 stickyMode :: FileMode
 stickyMode = 512
 
-setSticky :: FilePath -> IO ()
+setSticky :: RawFilePath -> IO ()
 setSticky f = modifyFileMode f $ addModes [stickyMode]
 #endif
 
@@ -173,13 +164,13 @@ setSticky f = modifyFileMode f $ addModes [stickyMode]
  - On a filesystem that does not support file permissions, this is the same
  - as writeFile.
  -}
-writeFileProtected :: FilePath -> String -> IO ()
+writeFileProtected :: RawFilePath -> String -> IO ()
 writeFileProtected file content = writeFileProtected' file 
 	(\h -> hPutStr h content)
 
-writeFileProtected' :: FilePath -> (Handle -> IO ()) -> IO ()
+writeFileProtected' :: RawFilePath -> (Handle -> IO ()) -> IO ()
 writeFileProtected' file writer = protectedOutput $
-	withFile file WriteMode $ \h -> do
+	withFile (fromRawFilePath file) WriteMode $ \h -> do
 		void $ tryIO $ modifyFileMode file $ removeModes otherGroupModes
 		writer h
 
diff --git a/Utility/FileSize.hs b/Utility/FileSize.hs
index 8544ad4..a503fda 100644
--- a/Utility/FileSize.hs
+++ b/Utility/FileSize.hs
@@ -1,5 +1,7 @@
 {- File size.
  -
+ - Copyright 2015-2020 Joey Hess <id@joeyh.name>
+ -
  - License: BSD-2-clause
  -}
 
@@ -12,10 +14,12 @@ module Utility.FileSize (
 	getFileSize',
 ) where
 
-import System.PosixCompat.Files
+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
 #endif
 
 type FileSize = Integer
@@ -26,18 +30,18 @@ type FileSize = Integer
  - FileOffset which maxes out at 2 gb.
  - See https://github.com/jystic/unix-compat/issues/16
  -}
-getFileSize :: FilePath -> IO FileSize
+getFileSize :: R.RawFilePath -> IO FileSize
 #ifndef mingw32_HOST_OS
-getFileSize f = fmap (fromIntegral . fileSize) (getFileStatus f)
+getFileSize f = fmap (fromIntegral . fileSize) (R.getFileStatus f)
 #else
-getFileSize f = bracket (openFile f ReadMode) hClose hFileSize
+getFileSize f = bracket (openFile (fromRawFilePath f) ReadMode) hClose hFileSize
 #endif
 
 {- Gets the size of the file, when its FileStatus is already known.
  -
  - On windows, uses getFileSize. Otherwise, the FileStatus contains the
  - size, so this does not do any work. -}
-getFileSize' :: FilePath -> FileStatus -> IO FileSize
+getFileSize' :: R.RawFilePath -> FileStatus -> IO FileSize
 #ifndef mingw32_HOST_OS
 getFileSize' _ s = return $ fromIntegral $ fileSize s
 #else
diff --git a/Utility/FileSystemEncoding.hs b/Utility/FileSystemEncoding.hs
index 4c099ff..1f7c76b 100644
--- a/Utility/FileSystemEncoding.hs
+++ b/Utility/FileSystemEncoding.hs
@@ -36,17 +36,18 @@ import Foreign.C
 import System.IO
 import System.IO.Unsafe
 import Data.Word
-import Data.List
+import System.FilePath.ByteString (RawFilePath, encodeFilePath, decodeFilePath)
 import qualified Data.ByteString as S
 import qualified Data.ByteString.Lazy as L
 #ifdef mingw32_HOST_OS
 import qualified Data.ByteString.UTF8 as S8
 import qualified Data.ByteString.Lazy.UTF8 as L8
+#else
+import Data.List
+import Utility.Split
 #endif
-import System.FilePath.ByteString (RawFilePath, encodeFilePath, decodeFilePath)
 
 import Utility.Exception
-import Utility.Split
 
 {- Makes all subsequent Handles that are opened, as well as stdio Handles,
  - use the filesystem encoding, instead of the encoding of the current
@@ -178,6 +179,7 @@ fromRawFilePath = decodeFilePath
 toRawFilePath :: FilePath -> RawFilePath
 toRawFilePath = encodeFilePath
 
+#ifndef mingw32_HOST_OS
 {- Converts a [Word8] to a FilePath, encoding using the filesystem encoding.
  -
  - w82s produces a String, which may contain Chars that are invalid
@@ -206,6 +208,7 @@ decodeW8NUL :: FilePath -> [Word8]
 decodeW8NUL = intercalate [c2w8 nul] . map decodeW8 . splitc nul
   where
 	nul = '\NUL'
+#endif
 
 c2w8 :: Char -> Word8
 c2w8 = fromIntegral . fromEnum
diff --git a/Utility/Format.hs b/Utility/Format.hs
index a2470fa..466988c 100644
--- a/Utility/Format.hs
+++ b/Utility/Format.hs
@@ -1,6 +1,6 @@
 {- Formatted string handling.
  -
- - Copyright 2010, 2011 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2020 Joey Hess <id@joeyh.name>
  -
  - License: BSD-2-clause
  -}
@@ -9,8 +9,10 @@ module Utility.Format (
 	Format,
 	gen,
 	format,
+	formatContainsVar,
 	decode_c,
 	encode_c,
+	encode_c',
 	prop_encode_c_decode_c_roundtrip
 ) where
 
@@ -29,9 +31,14 @@ type FormatString = String
 {- A format consists of a list of fragments. -}
 type Format = [Frag]
 
-{- A fragment is either a constant string,
- - or a variable, with a justification. -}
-data Frag = Const String | Var String Justify
+{- A fragment is either a constant string, or a variable. -}
+data Frag
+	= Const String 
+	| Var
+		{ varName :: String
+		, varJustify :: Justify
+		, varEscaped :: Bool
+		}
 	deriving (Show)
 
 data Justify = LeftJustified Int | RightJustified Int | UnJustified
@@ -45,10 +52,8 @@ format :: Format -> Variables -> String
 format f vars = concatMap expand f
   where
 	expand (Const s) = s
-	expand (Var name j)
-		| "escaped_" `isPrefixOf` name =
-			justify j $ encode_c_strict $
-				getvar $ drop (length "escaped_") name
+	expand (Var name j esc)
+		| esc = justify j $ encode_c' isSpace $ getvar name
 		| otherwise = justify j $ getvar name
 	getvar name = fromMaybe "" $ M.lookup name vars
 	justify UnJustified s        = s
@@ -61,6 +66,8 @@ format f vars = concatMap expand f
  - format string, such as "${foo} ${bar;10} ${baz;-10}\n"
  -
  - (This is the same type of format string used by dpkg-query.)
+ -
+ - Also, "${escaped_foo}" will apply encode_c to the value of variable foo.
  -}
 gen :: FormatString -> Format
 gen = filter (not . empty) . fuse [] . scan [] . decode_c
@@ -94,12 +101,24 @@ gen = filter (not . empty) . fuse [] . scan [] . decode_c
 		| i < 0 = LeftJustified (-1 * i)
 		| otherwise = RightJustified i
 	novar v = "${" ++ reverse v
-	foundvar f v p = scan (Var (reverse v) p : f)
+	foundvar f varname_r p = 
+		let varname = reverse varname_r
+		    var = if "escaped_" `isPrefixOf` varname
+			then Var (drop (length "escaped_") varname) p True
+			else Var varname p False
+		in scan (var : f)
 
 empty :: Frag -> Bool
 empty (Const "") = True
 empty _ = False
 
+{- Check if a Format contains a variable with a specified name. -}
+formatContainsVar :: String -> Format -> Bool
+formatContainsVar v = any go
+  where
+	go (Var v' _ _) | v' == v = True
+	go _ = False
+
 {- Decodes a C-style encoding, where \n is a newline (etc),
  - \NNN is an octal encoded character, and \xNN is a hex encoded character.
  -}
@@ -144,10 +163,7 @@ decode_c s = unescape ("", s)
 encode_c :: String -> FormatString
 encode_c = encode_c' (const False)
 
-{- Encodes more strictly, including whitespace. -}
-encode_c_strict :: String -> FormatString
-encode_c_strict = encode_c' isSpace
-
+{- Encodes special characters, as well as any matching the predicate. -}
 encode_c' :: (Char -> Bool) -> String -> FormatString
 encode_c' p = concatMap echar
   where
@@ -165,8 +181,8 @@ encode_c' p = concatMap echar
 		| 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 -- unprintable ascii
-		| otherwise    = [c]     -- printable 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])
diff --git a/Utility/HumanTime.hs b/Utility/HumanTime.hs
index d90143e..5178531 100644
--- a/Utility/HumanTime.hs
+++ b/Utility/HumanTime.hs
@@ -19,7 +19,6 @@ module Utility.HumanTime (
 import Utility.PartialPrelude
 import Utility.QuickCheck
 
-import Control.Monad.Fail as Fail (MonadFail(..))
 import qualified Data.Map as M
 import Data.Time.Clock
 import Data.Time.Clock.POSIX (POSIXTime)
@@ -45,8 +44,10 @@ daysToDuration :: Integer -> Duration
 daysToDuration i = Duration $ i * dsecs
 
 {- Parses a human-input time duration, of the form "5h", "1m", "5h1m", etc -}
-parseDuration :: MonadFail m => String -> m Duration
-parseDuration = maybe parsefail (return . Duration) . go 0
+parseDuration :: String -> Either String Duration
+parseDuration d
+	| null d = parsefail
+	| otherwise = maybe parsefail (Right . Duration) $ go 0 d
   where
 	go n [] = return n
 	go n s = do
@@ -56,7 +57,7 @@ parseDuration = maybe parsefail (return . Duration) . go 0
 				u <- M.lookup c unitmap
 				go (n + num * u) rest
 			_ -> return $ n + num
-	parsefail = Fail.fail "duration parse error; expected eg \"5m\" or \"1h5m\""
+	parsefail = Left $ "failed to parse duration \"" ++ d ++ "\" (expected eg \"5m\" or \"1h5m\")"
 
 fromDuration :: Duration -> String
 fromDuration Duration { durationSeconds = d }
@@ -102,4 +103,4 @@ instance Arbitrary Duration where
 	arbitrary = Duration <$> nonNegative arbitrary
 
 prop_duration_roundtrips :: Duration -> Bool
-prop_duration_roundtrips d = parseDuration (fromDuration d) == Just d
+prop_duration_roundtrips d = parseDuration (fromDuration d) == Right d
diff --git a/Utility/InodeCache.hs b/Utility/InodeCache.hs
index d890fc7..74c6dff 100644
--- a/Utility/InodeCache.hs
+++ b/Utility/InodeCache.hs
@@ -186,15 +186,15 @@ readInodeCache s = case words s of
 
 genInodeCache :: RawFilePath -> TSDelta -> IO (Maybe InodeCache)
 genInodeCache f delta = catchDefaultIO Nothing $
-	toInodeCache delta (fromRawFilePath f) =<< R.getFileStatus f
+	toInodeCache delta f =<< R.getFileStatus f
 
-toInodeCache :: TSDelta -> FilePath -> FileStatus -> IO (Maybe InodeCache)
+toInodeCache :: TSDelta -> RawFilePath -> FileStatus -> IO (Maybe InodeCache)
 toInodeCache (TSDelta getdelta) f s
 	| isRegularFile s = do
 		delta <- getdelta
 		sz <- getFileSize' f s
 #ifdef mingw32_HOST_OS
-		mtime <- utcTimeToPOSIXSeconds <$> getModificationTime f
+		mtime <- utcTimeToPOSIXSeconds <$> getModificationTime (fromRawFilePath f)
 #else
 		let mtime = modificationTimeHiRes s
 #endif
diff --git a/Utility/Metered.hs b/Utility/Metered.hs
index ec16e33..1715f0b 100644
--- a/Utility/Metered.hs
+++ b/Utility/Metered.hs
@@ -1,6 +1,6 @@
 {- Metered IO and actions
  -
- - Copyright 2012-2018 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2020 Joey Hess <id@joeyh.name>
  -
  - License: BSD-2-clause
  -}
@@ -9,8 +9,10 @@
 
 module Utility.Metered (
 	MeterUpdate,
+	MeterState(..),
 	nullMeterUpdate,
 	combineMeterUpdate,
+	TotalSize(..),
 	BytesProcessed(..),
 	toBytesProcessed,
 	fromBytesProcessed,
@@ -29,6 +31,8 @@ module Utility.Metered (
 	ProgressParser,
 	commandMeter,
 	commandMeter',
+	commandMeterExitCode,
+	commandMeterExitCode',
 	demeterCommand,
 	demeterCommandEnv,
 	avoidProgress,
@@ -46,6 +50,7 @@ import Common
 import Utility.Percentage
 import Utility.DataUnits
 import Utility.HumanTime
+import Utility.SimpleProtocol as Proto
 
 import qualified Data.ByteString.Lazy as L
 import qualified Data.ByteString as S
@@ -73,7 +78,7 @@ combineMeterUpdate a b = \n -> a n >> b n
 
 {- Total number of bytes processed so far. -}
 newtype BytesProcessed = BytesProcessed Integer
-	deriving (Eq, Ord, Show)
+	deriving (Eq, Ord, Show, Read)
 
 class AsBytesProcessed a where
 	toBytesProcessed :: a -> BytesProcessed
@@ -165,8 +170,9 @@ hGetMetered h wantsize meterupdate = lazyRead zeroBytesProcessed
 		c <- S.hGet h (nextchunksize (fromBytesProcessed sofar))
 		if S.null c
 			then do
-				hClose h
-				return $ L.empty
+				when (wantsize /= Just 0) $
+					hClose h
+				return L.empty
 			else do
 				let !sofar' = addBytesProcessed sofar (S.length c)
 				meterupdate sofar'
@@ -218,7 +224,8 @@ watchFileSize f p a = bracket
 			p sz
 		watcher sz
 	getsz = catchDefaultIO zeroBytesProcessed $
-		toBytesProcessed <$> getFileSize f
+		toBytesProcessed <$> getFileSize f'
+	f' = toRawFilePath f
 
 data OutputHandler = OutputHandler
 	{ quietMode :: Bool
@@ -226,31 +233,45 @@ data OutputHandler = OutputHandler
 	}
 
 {- Parses the String looking for a command's progress output, and returns
- - Maybe the number of bytes done so far, and any any remainder of the
- - string that could be an incomplete progress output. That remainder
- - should be prepended to future output, and fed back in. This interface
- - allows the command's output to be read in any desired size chunk, or
- - even one character at a time.
+ - Maybe the number of bytes done so far, optionally a total size, 
+ - and any any remainder of the string that could be an incomplete
+ - progress output. That remainder should be prepended to future output,
+ - and fed back in. This interface allows the command's output to be read
+ - in any desired size chunk, or even one character at a time.
  -}
-type ProgressParser = String -> (Maybe BytesProcessed, String)
+type ProgressParser = String -> (Maybe BytesProcessed, Maybe TotalSize, String)
+
+newtype TotalSize = TotalSize Integer
+	deriving (Show, Eq)
 
 {- Runs a command and runs a ProgressParser on its output, in order
  - to update a meter.
+ -
+ - If the Meter is provided, the ProgressParser can report the total size,
+ - which allows creating a Meter before the size is known.
  -}
-commandMeter :: ProgressParser -> OutputHandler -> MeterUpdate -> FilePath -> [CommandParam] -> IO Bool
-commandMeter progressparser oh meterupdate cmd params = do
-	ret <- commandMeter' progressparser oh meterupdate cmd params
+commandMeter :: ProgressParser -> OutputHandler -> Maybe Meter -> MeterUpdate -> FilePath -> [CommandParam] -> IO Bool
+commandMeter progressparser oh meter meterupdate cmd params =
+	commandMeter' progressparser oh meter meterupdate cmd params id
+
+commandMeter' :: ProgressParser -> OutputHandler -> Maybe Meter -> MeterUpdate -> FilePath -> [CommandParam] -> (CreateProcess -> CreateProcess) -> IO Bool
+commandMeter' progressparser oh meter meterupdate cmd params mkprocess = do
+	ret <- commandMeterExitCode' progressparser oh meter meterupdate cmd params mkprocess
 	return $ case ret of
 		Just ExitSuccess -> True
 		_ -> False
 
-commandMeter' :: ProgressParser -> OutputHandler -> MeterUpdate -> FilePath -> [CommandParam] -> IO (Maybe ExitCode)
-commandMeter' progressparser oh meterupdate cmd params = 
-	outputFilter cmd params Nothing
-		(feedprogress zeroBytesProcessed [])
+commandMeterExitCode :: ProgressParser -> OutputHandler -> Maybe Meter -> MeterUpdate -> FilePath -> [CommandParam] -> IO (Maybe ExitCode)
+commandMeterExitCode progressparser oh meter meterupdate cmd params =
+	commandMeterExitCode' progressparser oh meter meterupdate cmd params id
+
+commandMeterExitCode' :: ProgressParser -> OutputHandler -> Maybe Meter -> MeterUpdate -> FilePath -> [CommandParam] -> (CreateProcess -> CreateProcess) -> IO (Maybe ExitCode)
+commandMeterExitCode' progressparser oh mmeter meterupdate cmd params mkprocess = 
+	outputFilter cmd params mkprocess Nothing
+		(const $ feedprogress mmeter zeroBytesProcessed [])
 		handlestderr
   where
-	feedprogress prev buf h = do
+	feedprogress sendtotalsize prev buf h = do
 		b <- S.hGetSome h 80
 		if S.null b
 			then return ()
@@ -259,17 +280,24 @@ commandMeter' progressparser oh meterupdate cmd params =
 					S.hPut stdout b
 					hFlush stdout
 				let s = decodeBS b
-				let (mbytes, buf') = progressparser (buf++s)
+				let (mbytes, mtotalsize, buf') = progressparser (buf++s)
+				sendtotalsize' <- case (sendtotalsize, mtotalsize) of
+					(Just meter, Just t) -> do
+						setMeterTotalSize meter t
+						return Nothing
+					_ -> return sendtotalsize
 				case mbytes of
-					Nothing -> feedprogress prev buf' h
+					Nothing -> feedprogress sendtotalsize' prev buf' h
 					(Just bytes) -> do
 						when (bytes /= prev) $
 							meterupdate bytes
-						feedprogress bytes buf' h
+						feedprogress sendtotalsize' bytes buf' h
 
-	handlestderr h = unlessM (hIsEOF h) $ do
-		stderrHandler oh =<< hGetLine h
-		handlestderr h
+	handlestderr ph h = hGetLineUntilExitOrEOF ph h >>= \case
+		Just l -> do
+			stderrHandler oh l
+			handlestderr ph h
+		Nothing -> return ()
 
 {- Runs a command, that may display one or more progress meters on
  - either stdout or stderr, and prevents the meters from being displayed.
@@ -281,9 +309,9 @@ demeterCommand oh cmd params = demeterCommandEnv oh cmd params Nothing
 
 demeterCommandEnv :: OutputHandler -> FilePath -> [CommandParam] -> Maybe [(String, String)] -> IO Bool
 demeterCommandEnv oh cmd params environ = do
-	ret <- outputFilter cmd params environ
-		(\outh -> avoidProgress True outh stdouthandler)
-		(\errh -> avoidProgress True errh $ stderrHandler oh)
+	ret <- outputFilter cmd params id environ
+		(\ph outh -> avoidProgress True ph outh stdouthandler)
+		(\ph errh -> avoidProgress True ph errh $ stderrHandler oh)
 	return $ case ret of
 		Just ExitSuccess -> True
 		_ -> False
@@ -296,31 +324,39 @@ demeterCommandEnv oh cmd params environ = do
  - filter out lines that contain \r (typically used to reset to the
  - beginning of the line when updating a progress display).
  -}
-avoidProgress :: Bool -> Handle -> (String -> IO ()) -> IO ()
-avoidProgress doavoid h emitter = unlessM (hIsEOF h) $ do
-	s <- hGetLine h
-	unless (doavoid && '\r' `elem` s) $
-		emitter s
-	avoidProgress doavoid h emitter
+avoidProgress :: Bool -> ProcessHandle -> Handle -> (String -> IO ()) -> IO ()
+avoidProgress doavoid ph h emitter = hGetLineUntilExitOrEOF ph h >>= \case
+	Just s -> do
+		unless (doavoid && '\r' `elem` s) $
+			emitter s
+		avoidProgress doavoid ph h emitter
+	Nothing -> return ()
 
 outputFilter
 	:: FilePath
 	-> [CommandParam]
+	-> (CreateProcess -> CreateProcess)
 	-> Maybe [(String, String)]
-	-> (Handle -> IO ())
-	-> (Handle -> IO ())
+	-> (ProcessHandle -> Handle -> IO ())
+	-> (ProcessHandle -> Handle -> IO ())
 	-> IO (Maybe ExitCode)
-outputFilter cmd params environ outfilter errfilter = catchMaybeIO $ do
-	(_, Just outh, Just errh, pid) <- createProcess p
-		{ std_out = CreatePipe
+outputFilter cmd params mkprocess environ outfilter errfilter = 
+	catchMaybeIO $ withCreateProcess p go
+  where
+	go _ (Just outh) (Just errh) ph = do
+		outt <- async $ tryIO (outfilter ph outh) >> hClose outh
+		errt <- async $ tryIO (errfilter ph errh) >> hClose errh
+		ret <- waitForProcess ph
+		wait outt
+		wait errt
+		return ret
+	go _ _ _ _ = error "internal"
+	
+	p = mkprocess (proc cmd (toCommand params))
+		{ env = environ
+		, std_out = CreatePipe
 		, std_err = CreatePipe
 		}
-	void $ async $ tryIO (outfilter outh) >> hClose outh
-	void $ async $ tryIO (errfilter errh) >> hClose errh
-	waitForProcess pid
-  where
-	p = (proc cmd (toCommand params))
-		{ env = environ }
 
 -- | Limit a meter to only update once per unit of time.
 --
@@ -333,7 +369,7 @@ rateLimitMeterUpdate delta (Meter totalsizev _ _ _) meterupdate = do
 	return $ mu lastupdate
   where
 	mu lastupdate n@(BytesProcessed i) = readMVar totalsizev >>= \case
-		Just t | i >= t -> meterupdate n
+		Just (TotalSize t) | i >= t -> meterupdate n
 		_ -> do
 			now <- getPOSIXTime
 			prev <- takeMVar lastupdate
@@ -343,33 +379,39 @@ rateLimitMeterUpdate delta (Meter totalsizev _ _ _) meterupdate = do
 					meterupdate n
 				else putMVar lastupdate prev
 
-data Meter = Meter (MVar (Maybe Integer)) (MVar MeterState) (MVar String) DisplayMeter
+data Meter = Meter (MVar (Maybe TotalSize)) (MVar MeterState) (MVar String) DisplayMeter
 
-type MeterState = (BytesProcessed, POSIXTime)
+data MeterState = MeterState
+	{ meterBytesProcessed :: BytesProcessed
+	, meterTimeStamp :: POSIXTime
+	} deriving (Show)
 
-type DisplayMeter = MVar String -> Maybe Integer -> (BytesProcessed, POSIXTime) -> (BytesProcessed, POSIXTime) -> IO ()
+type DisplayMeter = MVar String -> Maybe TotalSize -> MeterState -> MeterState -> IO ()
 
-type RenderMeter = Maybe Integer -> (BytesProcessed, POSIXTime) -> (BytesProcessed, POSIXTime) -> String
+type RenderMeter = Maybe TotalSize -> MeterState -> MeterState -> String
 
 -- | Make a meter. Pass the total size, if it's known.
-mkMeter :: Maybe Integer -> DisplayMeter -> IO Meter
-mkMeter totalsize displaymeter = Meter
-	<$> newMVar totalsize
-	<*> ((\t -> newMVar (zeroBytesProcessed, t)) =<< getPOSIXTime)
-	<*> newMVar ""
-	<*> pure displaymeter
-
-setMeterTotalSize :: Meter -> Integer -> IO ()
+mkMeter :: Maybe TotalSize -> DisplayMeter -> IO Meter
+mkMeter totalsize displaymeter = do
+	ts <- getPOSIXTime
+	Meter
+		<$> newMVar totalsize
+		<*> newMVar (MeterState zeroBytesProcessed ts)
+		<*> newMVar ""
+		<*> pure displaymeter
+
+setMeterTotalSize :: Meter -> TotalSize -> IO ()
 setMeterTotalSize (Meter totalsizev _ _ _) = void . swapMVar totalsizev . Just
 
 -- | Updates the meter, displaying it if necessary.
 updateMeter :: Meter -> MeterUpdate
 updateMeter (Meter totalsizev sv bv displaymeter) new = do
 	now <- getPOSIXTime
-	(old, before) <- swapMVar sv (new, now)
-	when (old /= new) $ do
+	let curms = MeterState new now
+	oldms <- swapMVar sv curms
+	when (meterBytesProcessed oldms /= new) $ do
 		totalsize <- readMVar totalsizev
-		displaymeter bv totalsize (old, before) (new, now)
+		displaymeter bv totalsize oldms curms
 
 -- | Display meter to a Handle.
 displayMeterHandle :: Handle -> RenderMeter -> DisplayMeter
@@ -394,7 +436,7 @@ clearMeterHandle (Meter _ _ v _) h = do
 -- or when total size is not known:
 --   1.3 MiB      300 KiB/s
 bandwidthMeter :: RenderMeter
-bandwidthMeter mtotalsize (BytesProcessed old, before) (BytesProcessed new, now) =
+bandwidthMeter mtotalsize (MeterState (BytesProcessed old) before) (MeterState (BytesProcessed new) now) =
 	unwords $ catMaybes
 		[ Just percentamount
 		-- Pad enough for max width: "100%  xxxx.xx KiB  xxxx KiB/s"
@@ -405,7 +447,7 @@ bandwidthMeter mtotalsize (BytesProcessed old, before) (BytesProcessed new, now)
   where
 	amount = roughSize' memoryUnits True 2 new
 	percentamount = case mtotalsize of
-		Just totalsize ->
+		Just (TotalSize totalsize) ->
 			let p = showPercentage 0 $
 				percentage totalsize (min new totalsize)
 			in p ++ replicate (6 - length p) ' ' ++ amount
@@ -417,8 +459,12 @@ bandwidthMeter mtotalsize (BytesProcessed old, before) (BytesProcessed new, now)
 	transferred = max 0 (new - old)
 	duration = max 0 (now - before)
 	estimatedcompletion = case mtotalsize of
-		Just totalsize
+		Just (TotalSize totalsize)
 			| bytespersecond > 0 -> 
 				Just $ fromDuration $ Duration $
 					(totalsize - new) `div` bytespersecond
 		_ -> Nothing
+
+instance Proto.Serializable BytesProcessed where
+	serialize (BytesProcessed n) = show n
+	deserialize = BytesProcessed <$$> readish
diff --git a/Utility/MoveFile.hs b/Utility/MoveFile.hs
new file mode 100644
index 0000000..3ea17e8
--- /dev/null
+++ b/Utility/MoveFile.hs
@@ -0,0 +1,74 @@
+{- moving files
+ -
+ - Copyright 2011-2020 Joey Hess <id@joeyh.name>
+ -
+ - License: BSD-2-clause
+ -}
+
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE LambdaCase #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
+
+module Utility.MoveFile (
+	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 Control.Monad.IfElse
+import Utility.SafeCommand
+#endif
+
+import Utility.SystemDirectory
+import Utility.Tmp
+import Utility.Exception
+import Utility.Monad
+
+{- 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
+  where
+	onrename (Right _) = noop
+	onrename (Left e)
+		| isPermissionError e = rethrow
+		| isDoesNotExistError e = rethrow
+		| otherwise = viaTmp mv dest ()
+	  where
+		rethrow = throwM e
+
+		mv tmp () = do
+			-- 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.
+#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]
+			let e' = e
+#else
+			r <- tryIO $ copyFile src tmp
+			let (ok, e') = case r of
+				Left err -> (False, err)
+				Right _ -> (True, e)
+#endif
+			unless ok $ do
+				-- delete any partial
+				_ <- tryIO $ removeFile tmp
+				throwM e'
+
+#ifndef mingw32_HOST_OS	
+	isdir f = do
+		r <- tryIO $ getFileStatus f
+		case r of
+			(Left _) -> return False
+			(Right s) -> return $ isDirectory s
+#endif
diff --git a/Utility/Path.hs b/Utility/Path.hs
index a8ab918..6bd407e 100644
--- a/Utility/Path.hs
+++ b/Utility/Path.hs
@@ -1,63 +1,59 @@
 {- path manipulation
  -
- - Copyright 2010-2014 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2020 Joey Hess <id@joeyh.name>
  -
  - License: BSD-2-clause
  -}
 
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE CPP #-}
 {-# OPTIONS_GHC -fno-warn-tabs #-}
 
 module Utility.Path (
 	simplifyPath,
-	absPathFrom,
 	parentDir,
 	upFrom,
 	dirContains,
-	absPath,
-	relPathCwdToFile,
-	relPathDirToFile,
-	relPathDirToFileAbs,
 	segmentPaths,
+	segmentPaths',
 	runSegmentPaths,
-	relHome,
+	runSegmentPaths',
 	inPath,
 	searchPath,
 	dotfile,
-	sanitizeFilePath,
 	splitShortExtensions,
-
-	prop_upFrom_basics,
-	prop_relPathDirToFile_basics,
-	prop_relPathDirToFile_regressionTest,
+	relPathDirToFileAbs,
 ) where
 
-import System.FilePath
+import System.FilePath.ByteString
+import qualified System.FilePath as P
+import qualified Data.ByteString as B
 import Data.List
 import Data.Maybe
-import Data.Char
 import Control.Applicative
 import Prelude
 
 import Utility.Monad
-import Utility.UserInfo
 import Utility.SystemDirectory
-import Utility.Split
+
+#ifdef mingw32_HOST_OS
+import Data.Char
 import Utility.FileSystemEncoding
+#endif
 
 {- Simplifies a path, removing any "." component, collapsing "dir/..", 
  - and removing the trailing path separator.
  -
  - On Windows, preserves whichever style of path separator might be used in
- - the input FilePaths. This is done because some programs in Windows
+ - the input RawFilePaths. This is done because some programs in Windows
  - demand a particular path separator -- and which one actually varies!
  -
  - 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.FilePath
+ - yeild the same result. Run both through normalise from System.RawFilePath
  - to ensure that.
  -}
-simplifyPath :: FilePath -> FilePath
+simplifyPath :: RawFilePath -> RawFilePath
 simplifyPath path = dropTrailingPathSeparator $ 
 	joinDrive drive $ joinPath $ norm [] $ splitPath path'
   where
@@ -72,134 +68,37 @@ simplifyPath path = dropTrailingPathSeparator $
 	  where
 		p' = dropTrailingPathSeparator p
 
-{- Makes a path absolute.
- -
- - 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.
- -
- - Does not attempt to deal with edge cases or ensure security with
- - untrusted inputs.
- -}
-absPathFrom :: FilePath -> FilePath -> FilePath
-absPathFrom dir path = simplifyPath (combine dir path)
-
 {- takeDirectory "foo/bar/" is "foo/bar". This instead yields "foo" -}
-parentDir :: FilePath -> FilePath
+parentDir :: RawFilePath -> RawFilePath
 parentDir = takeDirectory . dropTrailingPathSeparator
 
 {- Just the parent directory of a path, or Nothing if the path has no
-- parent (ie for "/" or ".") -}
-upFrom :: FilePath -> Maybe FilePath
+- parent (ie for "/" or "." or "foo") -}
+upFrom :: RawFilePath -> Maybe RawFilePath
 upFrom dir
 	| length dirs < 2 = Nothing
-	| otherwise = Just $ joinDrive drive $ intercalate s $ init dirs
+	| otherwise = Just $ joinDrive drive $
+		B.intercalate (B.singleton pathSeparator) $ init dirs
   where
 	-- on Unix, the drive will be "/" when the dir is absolute,
 	-- otherwise ""
 	(drive, path) = splitDrive dir
-	s = [pathSeparator]
-	dirs = filter (not . null) $ split s path
-
-prop_upFrom_basics :: FilePath -> Bool
-prop_upFrom_basics dir
-	| null dir = True
-	| dir == "/" = p == Nothing
-	| otherwise = p /= Just dir
-  where
-	p = upFrom dir
+	dirs = filter (not . B.null) $ B.splitWith isPathSeparator path
 
-{- Checks if the first FilePath is, or could be said to contain the second.
+{- 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.
  -}
-dirContains :: FilePath -> FilePath -> Bool
+dirContains :: RawFilePath -> RawFilePath -> Bool
 dirContains a b = a == b
 	|| a' == b'
-	|| (addTrailingPathSeparator a') `isPrefixOf` b'
+	|| (addTrailingPathSeparator a') `B.isPrefixOf` b'
 	|| a' == "." && normalise ("." </> b') == b'
   where
 	a' = norm a
 	b' = norm b
 	norm = normalise . simplifyPath
 
-{- Converts a filename into an absolute path.
- -
- - Also simplifies it using simplifyPath.
- -
- - Unlike Directory.canonicalizePath, this does not require the path
- - already exists. -}
-absPath :: FilePath -> IO FilePath
-absPath file
-	-- Avoid unncessarily getting the current directory when the path
-	-- is already absolute. absPathFrom uses simplifyPath
-	-- so also used here for consistency.
-	| isAbsolute file = return $ simplifyPath file
-	| otherwise = do
-		cwd <- getCurrentDirectory
-		return $ absPathFrom cwd file
-
-{- Constructs a relative path from the CWD to a file.
- -
- - For example, assuming CWD is /tmp/foo/bar:
- -    relPathCwdToFile "/tmp/foo" == ".."
- -    relPathCwdToFile "/tmp/foo/bar" == "" 
- -}
-relPathCwdToFile :: FilePath -> IO FilePath
-relPathCwdToFile f = do
-	c <- getCurrentDirectory
-	relPathDirToFile c f
-
-{- Constructs a relative path from a directory to a file. -}
-relPathDirToFile :: FilePath -> FilePath -> IO FilePath
-relPathDirToFile from to = relPathDirToFileAbs <$> absPath from <*> absPath to
-
-{- This requires the first path to be absolute, and the
- - second path cannot contain ../ or ./
- -
- - On Windows, if the paths are on different drives,
- - a relative path is not possible and the path is simply
- - returned as-is.
- -}
-relPathDirToFileAbs :: FilePath -> FilePath -> FilePath
-relPathDirToFileAbs from to
-#ifdef mingw32_HOST_OS
-	| normdrive from /= normdrive to = to
-#endif
-	| otherwise = joinPath $ dotdots ++ uncommon
-  where
-	pfrom = sp from
-	pto = sp to
-	sp = map dropTrailingPathSeparator . splitPath . dropDrive
-	common = map fst $ takeWhile same $ zip pfrom pto
-	same (c,d) = c == d
-	uncommon = drop numcommon pto
-	dotdots = replicate (length pfrom - numcommon) ".."
-	numcommon = length common
-#ifdef mingw32_HOST_OS
-	normdrive = map toLower . takeWhile (/= ':') . takeDrive
-#endif
-
-prop_relPathDirToFile_basics :: FilePath -> FilePath -> Bool
-prop_relPathDirToFile_basics from to
-	| null from || null to = True
-	| from == to = null r
-	| otherwise = not (null r)
-  where
-	r = relPathDirToFileAbs from to 
-
-prop_relPathDirToFile_regressionTest :: Bool
-prop_relPathDirToFile_regressionTest = same_dir_shortcurcuits_at_difference
-  where
-	{- Two paths have the same directory component at the same
-	 - location, but it's not really the same directory.
-	 - Code used to get this wrong. -}
-	same_dir_shortcurcuits_at_difference =
-		relPathDirToFileAbs (joinPath [pathSeparator : "tmp", "r", "lll", "xxx", "yyy", "18"])
-			(joinPath [pathSeparator : "tmp", "r", ".git", "annex", "objects", "18", "gk", "SHA256-foo", "SHA256-foo"])
-				== joinPath ["..", "..", "..", "..", ".git", "annex", "objects", "18", "gk", "SHA256-foo", "SHA256-foo"]
-
 {- Given an original list of paths, and an expanded list derived from it,
  - which may be arbitrarily reordered, generates a list of lists, where
  - each sublist corresponds to one of the original paths.
@@ -213,30 +112,29 @@ prop_relPathDirToFile_regressionTest = same_dir_shortcurcuits_at_difference
  - we stop preserving ordering at that point. Presumably a user passing
  - that many paths in doesn't care too much about order of the later ones.
  -}
-segmentPaths :: [RawFilePath] -> [RawFilePath] -> [[RawFilePath]]
-segmentPaths [] new = [new]
-segmentPaths [_] new = [new] -- optimisation
-segmentPaths (l:ls) new = found : segmentPaths ls rest
+segmentPaths :: (a -> RawFilePath) -> [RawFilePath] -> [a] -> [[a]]
+segmentPaths = segmentPaths' (\_ r -> r)
+
+segmentPaths' :: (Maybe RawFilePath -> a -> r) -> (a -> RawFilePath) -> [RawFilePath] -> [a] -> [[r]]
+segmentPaths' f _ [] new = [map (f Nothing) new]
+segmentPaths' f _ [i] new = [map (f (Just i)) new] -- optimisation
+segmentPaths' f c (i:is) new = 
+	map (f (Just i)) found : segmentPaths' f c is rest
   where
-	(found, rest) = if length ls < 100
-		then partition inl new
-		else break (not . inl) new
-	inl f = fromRawFilePath l `dirContains` fromRawFilePath f
+	(found, rest) = if length is < 100
+		then partition ini new
+		else break (not . ini) new
+	ini p = i `dirContains` c p
 
 {- This assumes that it's cheaper to call segmentPaths on the result,
  - than it would be to run the action separately with each path. In
  - the case of git file list commands, that assumption tends to hold.
  -}
-runSegmentPaths :: ([RawFilePath] -> IO [RawFilePath]) -> [RawFilePath] -> IO [[RawFilePath]]
-runSegmentPaths a paths = segmentPaths paths <$> a paths
+runSegmentPaths :: (a -> RawFilePath) -> ([RawFilePath] -> IO [a]) -> [RawFilePath] -> IO [[a]]
+runSegmentPaths c a paths = segmentPaths c paths <$> a paths
 
-{- Converts paths in the home directory to use ~/ -}
-relHome :: FilePath -> IO String
-relHome path = do
-	home <- myHomeDir
-	return $ if dirContains home path
-		then "~/" ++ relPathDirToFileAbs home path
-		else path
+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.
  -
@@ -254,10 +152,10 @@ inPath command = isJust <$> searchPath command
  -}
 searchPath :: String -> IO (Maybe FilePath)
 searchPath command
-	| isAbsolute command = check command
-	| otherwise = getSearchPath >>= getM indir
+	| P.isAbsolute command = check command
+	| otherwise = P.getSearchPath >>= getM indir
   where
-	indir d = check $ d </> command
+	indir d = check $ d P.</> command
 	check f = firstM doesFileExist
 #ifdef mingw32_HOST_OS
 		[f, f ++ ".exe"]
@@ -267,42 +165,52 @@ searchPath command
 
 {- Checks if a filename is a unix dotfile. All files inside dotdirs
  - count as dotfiles. -}
-dotfile :: FilePath -> Bool
+dotfile :: RawFilePath -> Bool
 dotfile file
 	| f == "." = False
 	| f == ".." = False
 	| f == "" = False
-	| otherwise = "." `isPrefixOf` f || dotfile (takeDirectory file)
+	| otherwise = "." `B.isPrefixOf` f || dotfile (takeDirectory file)
   where
 	f = takeFileName file
 
-{- Given a string that we'd like to use as the basis for FilePath, but that
- - was provided by a third party and is not to be trusted, returns the closest
- - sane FilePath.
- -
- - All spaces and punctuation and other wacky stuff are replaced
- - with '_', except for '.'
- - "../" will thus turn into ".._", which is safe.
- -}
-sanitizeFilePath :: String -> FilePath
-sanitizeFilePath = map sanitize
-  where
-	sanitize c
-		| c == '.' = c
-		| isSpace c || isPunctuation c || isSymbol c || isControl c || c == '/' = '_'
-		| otherwise = c
-
-{- Similar to splitExtensions, but knows that some things in FilePaths
+{- Similar to splitExtensions, but knows that some things in RawFilePaths
  - after a dot are too long to be extensions. -}
-splitShortExtensions :: FilePath -> (FilePath, [String])
+splitShortExtensions :: RawFilePath -> (RawFilePath, [B.ByteString])
 splitShortExtensions = splitShortExtensions' 5 -- enough for ".jpeg"
-splitShortExtensions' :: Int -> FilePath -> (FilePath, [String])
+splitShortExtensions' :: Int -> RawFilePath -> (RawFilePath, [B.ByteString])
 splitShortExtensions' maxextension = go []
   where
 	go c f
-		| len > 0 && len <= maxextension && not (null base) = 
+		| len > 0 && len <= maxextension && not (B.null base) = 
 			go (ext:c) base
 		| otherwise = (f, c)
 	  where
 		(base, ext) = splitExtension f
-		len = length ext
+		len = B.length ext
+
+{- This requires the first path to be absolute, and the
+ - second path cannot contain ../ or ./
+ -
+ - On Windows, if the paths are on different drives,
+ - a relative path is not possible and the path is simply
+ - returned as-is.
+ -}
+relPathDirToFileAbs :: RawFilePath -> RawFilePath -> RawFilePath
+relPathDirToFileAbs from to
+#ifdef mingw32_HOST_OS
+	| normdrive from /= normdrive to = to
+#endif
+	| otherwise = joinPath $ dotdots ++ uncommon
+  where
+	pfrom = sp from
+	pto = sp to
+	sp = map dropTrailingPathSeparator . splitPath . dropDrive
+	common = map fst $ takeWhile same $ zip pfrom pto
+	same (c,d) = c == d
+	uncommon = drop numcommon pto
+	dotdots = replicate (length pfrom - numcommon) ".."
+	numcommon = length common
+#ifdef mingw32_HOST_OS
+	normdrive = map toLower . takeWhile (/= ':') . fromRawFilePath . takeDrive
+#endif
diff --git a/Utility/Path/AbsRel.hs b/Utility/Path/AbsRel.hs
new file mode 100644
index 0000000..0026bd6
--- /dev/null
+++ b/Utility/Path/AbsRel.hs
@@ -0,0 +1,93 @@
+{- absolute and relative path manipulation
+ -
+ - Copyright 2010-2020 Joey Hess <id@joeyh.name>
+ -
+ - License: BSD-2-clause
+ -}
+
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
+
+module Utility.Path.AbsRel (
+	absPathFrom,
+	absPath,
+	relPathCwdToFile,
+	relPathDirToFile,
+	relPathDirToFileAbs,
+	relHome,
+) where
+
+import System.FilePath.ByteString
+#ifdef mingw32_HOST_OS
+import System.Directory (getCurrentDirectory)
+#else
+import System.Posix.Directory.ByteString (getWorkingDirectory)
+#endif
+import Control.Applicative
+import Prelude
+
+import Utility.Path
+import Utility.UserInfo
+import Utility.FileSystemEncoding
+
+{- Makes a path absolute.
+ -
+ - 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.
+ -
+ - Does not attempt to deal with edge cases or ensure security with
+ - untrusted inputs.
+ -}
+absPathFrom :: RawFilePath -> RawFilePath -> RawFilePath
+absPathFrom dir path = simplifyPath (combine dir path)
+
+{- Converts a filename into an absolute path.
+ -
+ - Also simplifies it using simplifyPath.
+ -
+ - Unlike Directory.canonicalizePath, this does not require the path
+ - already exists. -}
+absPath :: RawFilePath -> IO RawFilePath
+absPath file
+	-- Avoid unncessarily getting the current directory when the path
+	-- is already absolute. absPathFrom uses simplifyPath
+	-- so also used here for consistency.
+	| isAbsolute file = return $ simplifyPath file
+	| otherwise = do
+#ifdef mingw32_HOST_OS
+		cwd <- toRawFilePath <$> getCurrentDirectory
+#else
+		cwd <- getWorkingDirectory
+#endif
+		return $ absPathFrom cwd file
+
+{- Constructs a relative path from the CWD to a file.
+ -
+ - For example, assuming CWD is /tmp/foo/bar:
+ -    relPathCwdToFile "/tmp/foo" == ".."
+ -    relPathCwdToFile "/tmp/foo/bar" == "" 
+ -}
+relPathCwdToFile :: RawFilePath -> IO RawFilePath
+relPathCwdToFile f = do
+#ifdef mingw32_HOST_OS
+	c <- toRawFilePath <$> getCurrentDirectory
+#else
+	c <- getWorkingDirectory
+#endif
+	relPathDirToFile c f
+
+{- Constructs a relative path from a directory to a file. -}
+relPathDirToFile :: RawFilePath -> RawFilePath -> IO RawFilePath
+relPathDirToFile from to = relPathDirToFileAbs <$> absPath from <*> absPath to
+
+{- Converts paths in the home directory to use ~/ -}
+relHome :: FilePath -> IO String
+relHome path = do
+	let path' = toRawFilePath path
+	home <- toRawFilePath <$> myHomeDir
+	return $ if dirContains home path'
+		then fromRawFilePath ("~/" <> relPathDirToFileAbs home path')
+		else path
diff --git a/Utility/Process.hs b/Utility/Process.hs
index e7142b9..4a725c8 100644
--- a/Utility/Process.hs
+++ b/Utility/Process.hs
@@ -6,12 +6,11 @@
  - License: BSD-2-clause
  -}
 
-{-# LANGUAGE CPP, Rank2Types #-}
+{-# LANGUAGE CPP, Rank2Types, LambdaCase #-}
 {-# OPTIONS_GHC -fno-warn-tabs #-}
 
 module Utility.Process (
 	module X,
-	CreateProcess(..),
 	StdHandle(..),
 	readProcess,
 	readProcess',
@@ -20,64 +19,55 @@ module Utility.Process (
 	forceSuccessProcess,
 	forceSuccessProcess',
 	checkSuccessProcess,
-	ignoreFailureProcess,
-	createProcessSuccess,
-	createProcessChecked,
-	createBackgroundProcess,
-	withHandle,
-	withIOHandles,
-	withOEHandles,
 	withNullHandle,
-	withQuietOutput,
-	feedWithQuietOutput,
 	createProcess,
+	withCreateProcess,
 	waitForProcess,
+	cleanupProcess,
+	hGetLineUntilExitOrEOF,
 	startInteractiveProcess,
 	stdinHandle,
 	stdoutHandle,
 	stderrHandle,
-	ioHandles,
 	processHandle,
 	devNull,
 ) where
 
 import qualified Utility.Process.Shim
-import qualified Utility.Process.Shim as X hiding (CreateProcess(..), createProcess, runInteractiveProcess, readProcess, readProcessWithExitCode, system, rawSystem, runInteractiveCommand, runProcess)
-import Utility.Process.Shim hiding (createProcess, readProcess, waitForProcess)
+import Utility.Process.Shim as X (CreateProcess(..), ProcessHandle, StdStream(..), CmdSpec(..), proc, getPid, getProcessExitCode, shell, terminateProcess, interruptProcessGroupOf)
 import Utility.Misc
 import Utility.Exception
+import Utility.Monad
 
 import System.Exit
 import System.IO
 import System.Log.Logger
-import Control.Concurrent
-import qualified Control.Exception as E
-import Control.Monad
+import Control.Monad.IO.Class
+import Control.Concurrent.Async
 import qualified Data.ByteString as S
 
-type CreateProcessRunner = forall a. CreateProcess -> ((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO a) -> IO a
-
 data StdHandle = StdinHandle | StdoutHandle | StderrHandle
 	deriving (Eq)
 
 -- | Normally, when reading from a process, it does not need to be fed any
 -- standard input.
 readProcess :: FilePath	-> [String] -> IO String
-readProcess cmd args = readProcessEnv cmd args Nothing
+readProcess cmd args = readProcess' (proc cmd args)
 
 readProcessEnv :: FilePath -> [String] -> Maybe [(String, String)] -> IO String
-readProcessEnv cmd args environ = readProcess' p
-  where
-	p = (proc cmd args)
-		{ std_out = CreatePipe
-		, env = environ
-		}
+readProcessEnv cmd args environ = 
+	readProcess' $ (proc cmd args) { env = environ }
 
 readProcess' :: CreateProcess -> IO String
-readProcess' p = withHandle StdoutHandle createProcessSuccess p $ \h -> do
-	output  <- hGetContentsStrict h
-	hClose h
-	return output
+readProcess' p = withCreateProcess p' go
+  where
+	p' = p { std_out = CreatePipe }
+	go _ (Just h) _ pid = do
+		output  <- hGetContentsStrict h
+		hClose h
+		forceSuccessProcess p' pid
+		return output
+	go _ _ _ _ = error "internal"
 
 -- | Runs an action to write to a process on its stdin, 
 -- returns its output, and also allows specifying the environment.
@@ -87,26 +77,7 @@ writeReadProcessEnv
 	-> Maybe [(String, String)]
 	-> (Maybe (Handle -> IO ()))
 	-> IO S.ByteString
-writeReadProcessEnv cmd args environ writestdin = do
-	(Just inh, Just outh, _, pid) <- createProcess p
-
-	-- fork off a thread to start consuming the output
-	outMVar <- newEmptyMVar
-	_ <- forkIO $ putMVar outMVar =<< S.hGetContents outh
-
-	-- now write and flush any input
-	maybe (return ()) (\a -> a inh >> hFlush inh) writestdin
-	hClose inh -- done with stdin
-
-	-- wait on the output
-	output <- takeMVar outMVar
-	hClose outh
-
-	-- wait on the process
-	forceSuccessProcess p pid
-
-	return output
-
+writeReadProcessEnv cmd args environ writestdin = withCreateProcess p go
   where
 	p = (proc cmd args)
 		{ std_in = CreatePipe
@@ -114,6 +85,18 @@ writeReadProcessEnv cmd args environ writestdin = do
 		, std_err = Inherit
 		, env = environ
 		}
+	
+	go (Just inh) (Just outh) _ pid = do
+		let reader = hClose outh `after` S.hGetContents outh
+		let writer = do
+			maybe (return ()) (\a -> a inh >> hFlush inh) writestdin
+			hClose inh
+		(output, ()) <- concurrently reader writer
+
+		forceSuccessProcess p pid
+
+		return output
+	go _ _ _ _ = error "internal"
 
 -- | Waits for a ProcessHandle, and throws an IOError if the process
 -- did not exit successfully.
@@ -126,117 +109,15 @@ forceSuccessProcess' p (ExitFailure n) = fail $
 	showCmd p ++ " exited " ++ show n
 
 -- | Waits for a ProcessHandle and returns True if it exited successfully.
--- Note that using this with createProcessChecked will throw away
--- the Bool, and is only useful to ignore the exit code of a process,
--- while still waiting for it. -}
 checkSuccessProcess :: ProcessHandle -> IO Bool
 checkSuccessProcess pid = do
 	code <- waitForProcess pid
 	return $ code == ExitSuccess
 
-ignoreFailureProcess :: ProcessHandle -> IO Bool
-ignoreFailureProcess pid = do
-	void $ waitForProcess pid
-	return True
-
--- | Runs createProcess, then an action on its handles, and then
--- forceSuccessProcess.
-createProcessSuccess :: CreateProcessRunner
-createProcessSuccess p a = createProcessChecked (forceSuccessProcess p) p a
-
--- | Runs createProcess, then an action on its handles, and then
--- a checker action on its exit code, which must wait for the process.
-createProcessChecked :: (ProcessHandle -> IO b) -> CreateProcessRunner
-createProcessChecked checker p a = do
-	t@(_, _, _, pid) <- createProcess p
-	r <- tryNonAsync $ a t
-	_ <- checker pid
-	either E.throw return r
-
--- | Leaves the process running, suitable for lazy streaming.
--- Note: Zombies will result, and must be waited on.
-createBackgroundProcess :: CreateProcessRunner
-createBackgroundProcess p a = a =<< createProcess p
-
--- | Runs a CreateProcessRunner, on a CreateProcess structure, that
--- is adjusted to pipe only from/to a single StdHandle, and passes
--- the resulting Handle to an action.
-withHandle
-	:: StdHandle
-	-> CreateProcessRunner
-	-> CreateProcess
-	-> (Handle -> IO a)
-	-> IO a
-withHandle h creator p a = creator p' $ a . select
-  where
-	base = p
-		{ std_in = Inherit
-		, std_out = Inherit
-		, std_err = Inherit
-		}
-	(select, p') = case h of
-		StdinHandle -> (stdinHandle, base { std_in = CreatePipe })
-		StdoutHandle -> (stdoutHandle, base { std_out = CreatePipe })
-		StderrHandle -> (stderrHandle, base { std_err = CreatePipe })
-
--- | Like withHandle, but passes (stdin, stdout) handles to the action.
-withIOHandles
-	:: CreateProcessRunner
-	-> CreateProcess
-	-> ((Handle, Handle) -> IO a)
-	-> IO a
-withIOHandles creator p a = creator p' $ a . ioHandles
-  where
-	p' = p
-		{ std_in = CreatePipe
-		, std_out = CreatePipe
-		, std_err = Inherit
-		}
-
--- | Like withHandle, but passes (stdout, stderr) handles to the action.
-withOEHandles
-	:: CreateProcessRunner
-	-> CreateProcess
-	-> ((Handle, Handle) -> IO a)
-	-> IO a
-withOEHandles creator p a = creator p' $ a . oeHandles
-  where
-	p' = p
-		{ std_in = Inherit
-		, std_out = CreatePipe
-		, std_err = CreatePipe
-		}
-
-withNullHandle :: (Handle -> IO a) -> IO a
-withNullHandle = withFile devNull WriteMode
-
--- | Forces the CreateProcessRunner to run quietly;
--- both stdout and stderr are discarded.
-withQuietOutput
-	:: CreateProcessRunner
-	-> CreateProcess
-	-> IO ()
-withQuietOutput creator p = withNullHandle $ \nullh -> do
-	let p' = p
-		{ std_out = UseHandle nullh
-		, std_err = UseHandle nullh
-		}
-	creator p' $ const $ return ()
-
--- | Stdout and stderr are discarded, while the process is fed stdin
--- from the handle.
-feedWithQuietOutput
-	:: CreateProcessRunner
-	-> CreateProcess
-	-> (Handle -> IO a)
-	-> IO a
-feedWithQuietOutput creator p a = withFile devNull WriteMode $ \nullh -> do
-	let p' = p
-		{ std_in = CreatePipe
-		, std_out = UseHandle nullh
-		, std_err = UseHandle nullh
-		}
-	creator p' $ a . stdinHandle
+withNullHandle :: (MonadIO m, MonadMask m) => (Handle -> m a) -> m a
+withNullHandle = bracket
+	(liftIO $ openFile devNull WriteMode)
+	(liftIO . hClose)
 
 devNull :: FilePath
 #ifndef mingw32_HOST_OS
@@ -252,6 +133,7 @@ devNull = "\\\\.\\NUL"
 -- Get it wrong and the runtime crash will always happen, so should be
 -- easily noticed.
 type HandleExtractor = (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> Handle
+
 stdinHandle :: HandleExtractor
 stdinHandle (Just h, _, _, _) = h
 stdinHandle _ = error "expected stdinHandle"
@@ -261,12 +143,6 @@ stdoutHandle _ = error "expected stdoutHandle"
 stderrHandle :: HandleExtractor
 stderrHandle (_, _, Just h, _) = h
 stderrHandle _ = error "expected stderrHandle"
-ioHandles :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> (Handle, Handle)
-ioHandles (Just hin, Just hout, _, _) = (hin, hout)
-ioHandles _ = error "expected ioHandles"
-oeHandles :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> (Handle, Handle)
-oeHandles (_, Just hout, Just herr, _) = (hout, herr)
-oeHandles _ = error "expected oeHandles"
 
 processHandle :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> ProcessHandle
 processHandle (_, _, _, pid) = pid
@@ -298,15 +174,24 @@ startInteractiveProcess cmd args environ = do
 -- | Wrapper around 'System.Process.createProcess' that does debug logging.
 createProcess :: CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
 createProcess p = do
-	debugProcess p
-	Utility.Process.Shim.createProcess p
+	r@(_, _, _, h) <- Utility.Process.Shim.createProcess p
+	debugProcess p h
+	return r
+
+-- | Wrapper around 'System.Process.withCreateProcess' that does debug logging.
+withCreateProcess :: CreateProcess -> (Maybe Handle -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a) -> IO a
+withCreateProcess p action = bracket (createProcess p) cleanupProcess
+	(\(m_in, m_out, m_err, ph) -> action m_in m_out m_err ph)
 
 -- | Debugging trace for a CreateProcess.
-debugProcess :: CreateProcess -> IO ()
-debugProcess p = debugM "Utility.Process" $ unwords
-	[ action ++ ":"
-	, showCmd p
-	]
+debugProcess :: CreateProcess -> ProcessHandle -> IO ()
+debugProcess p h = do
+	pid <- getPid h
+	debugM "Utility.Process" $ unwords
+		[ describePid pid
+		, action ++ ":"
+		, showCmd p
+		]
   where
 	action
 		| piped (std_in p) && piped (std_out p) = "chat"
@@ -316,9 +201,121 @@ debugProcess p = debugM "Utility.Process" $ unwords
 	piped Inherit = False
 	piped _ = True
 
+describePid :: Maybe Utility.Process.Shim.Pid -> String
+describePid Nothing = "process"
+describePid (Just p) = "process [" ++  show p ++ "]"
+
 -- | Wrapper around 'System.Process.waitForProcess' that does debug logging.
 waitForProcess ::  ProcessHandle -> IO ExitCode
 waitForProcess h = do
+	-- Have to get pid before waiting, which closes the ProcessHandle.
+	pid <- getPid h
 	r <- Utility.Process.Shim.waitForProcess h
-	debugM "Utility.Process" ("process done " ++ show r)
+	debugM "Utility.Process" (describePid pid ++ " done " ++ show r)
 	return r
+
+cleanupProcess :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO () 
+#if MIN_VERSION_process(1,6,4)
+cleanupProcess = Utility.Process.Shim.cleanupProcess
+#else
+cleanupProcess (mb_stdin, mb_stdout, mb_stderr, pid) = do
+	-- Unlike the real cleanupProcess, this does not wait
+	-- for the process to finish in the background, so if
+	-- the process ignores SIGTERM, this can block until the process
+	-- gets around the exiting.
+	terminateProcess pid
+	let void _ = return ()
+	maybe (return ()) (void . tryNonAsync . hClose) mb_stdin
+	maybe (return ()) hClose mb_stdout
+	maybe (return ()) hClose mb_stderr
+	void $ waitForProcess pid
+#endif
+
+{- | Like hGetLine, reads a line from the Handle. Returns Nothing if end of
+ - file is reached, or the handle is closed, or if the process has exited
+ - and there is nothing more buffered to read from the handle.
+ -
+ - This is useful to protect against situations where the process might
+ - have transferred the handle being read to another process, and so
+ - the handle could remain open after the process has exited. That is a rare
+ - situation, but can happen. Consider a the process that started up a
+ - daemon, and the daemon inherited stderr from it, rather than the more
+ - usual behavior of closing the file descriptor. Reading from stderr
+ - would block past the exit of the process.
+ -
+ - In that situation, this will detect when the process has exited,
+ - and avoid blocking forever. But will still return anything the process
+ - buffered to the handle before exiting.
+ -
+ - Note on newline mode: This ignores whatever newline mode is configured
+ - for the handle, because there is no way to query that. On Windows,
+ - it will remove any \r coming before the \n. On other platforms,
+ - it does not treat \r specially.
+ -}
+hGetLineUntilExitOrEOF :: ProcessHandle -> Handle -> IO (Maybe String)
+hGetLineUntilExitOrEOF ph h = go []
+  where
+	go buf = do
+		ready <- waitforinputorerror smalldelay
+		if ready
+			then getloop buf go
+			else getProcessExitCode ph >>= \case
+				-- Process still running, wait longer.
+				Nothing -> go buf
+				-- Process is done. It's possible
+				-- that it output something and exited
+				-- since the prior hWaitForInput,
+				-- so check one more time for any buffered
+				-- output.
+				Just _ -> finalcheck buf
+
+	finalcheck buf = do
+		ready <- waitforinputorerror 0
+		if ready
+			then getloop buf finalcheck
+			-- No remaining buffered input, though the handle
+			-- may not be EOF if something else is keeping it
+			-- open. Treated the same as EOF.
+			else eofwithnolineend buf
+
+	-- On exception, proceed as if there was input;
+	-- EOF and any encoding issues are dealt with
+	-- when reading from the handle.
+	waitforinputorerror t = hWaitForInput h t
+		`catchNonAsync` const (pure True)
+
+	getchar = 
+		catcherr EOF $
+			-- If the handle is closed, reading from it is
+			-- an IllegalOperation.
+			catcherr IllegalOperation $
+				Just <$> hGetChar h
+	  where
+		catcherr t = catchIOErrorType t (const (pure Nothing))
+
+	getloop buf cont =
+		getchar >>= \case
+			Just c
+				| c == '\n' -> return (Just (gotline buf))
+				| otherwise -> cont (c:buf)
+			Nothing -> eofwithnolineend buf
+
+#ifndef mingw32_HOST_OS
+	gotline buf = reverse buf
+#else
+	gotline ('\r':buf) = reverse buf
+	gotline buf = reverse buf
+#endif
+
+	eofwithnolineend buf = return $
+		if null buf 
+			then Nothing -- no line read
+			else Just (reverse buf)
+
+	-- Tenth of a second delay. If the process exits with the FD being
+	-- held open, will wait up to twice this long before returning.
+	-- This delay could be made smaller. However, that is an unusual
+	-- case, and making it too small would cause lots of wakeups while
+	-- waiting for output. Bearing in mind that this could be run on
+	-- many processes at the same time.
+	smalldelay = 100 -- milliseconds
diff --git a/Utility/QuickCheck.hs b/Utility/QuickCheck.hs
index b0a39f3..2093670 100644
--- a/Utility/QuickCheck.hs
+++ b/Utility/QuickCheck.hs
@@ -1,6 +1,6 @@
 {- QuickCheck with additional instances
  -
- - Copyright 2012-2014 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2020 Joey Hess <id@joeyh.name>
  -
  - License: BSD-2-clause
  -}
@@ -10,16 +10,53 @@
 
 module Utility.QuickCheck
 	( module X
-	, module Utility.QuickCheck
+	, TestableString
+	, fromTestableString
+	, TestableFilePath
+	, fromTestableFilePath
+	, nonNegative
+	, positive
 	) where
 
 import Test.QuickCheck as X
 import Data.Time.Clock.POSIX
 import Data.Ratio
+import Data.Char
 import System.Posix.Types
 import Data.List.NonEmpty (NonEmpty(..))
 import Prelude
 
+{- A String, but Arbitrary is limited to ascii.
+ -
+ - When in a non-utf8 locale, String does not normally contain any non-ascii
+ - characters, except for ones in surrogate plane. Converting a string that
+ - does contain other unicode characters to a ByteString using the
+ - filesystem encoding (see GHC.IO.Encoding) will throw an exception,
+ - so use this instead to avoid quickcheck tests breaking unncessarily.
+ -} 
+newtype TestableString = TestableString
+	{ fromTestableString :: String }
+	deriving (Show)
+
+instance Arbitrary TestableString where
+	arbitrary = TestableString . filter isAscii <$> arbitrary
+
+{- FilePath constrained to not be the empty string, not contain a NUL, 
+ - and contain only ascii.
+ -
+ - No real-world filename can be empty or contain a NUL. So code can
+ - well be written that assumes that and using this avoids quickcheck
+ - tests breaking unncessarily.
+ -} 
+newtype TestableFilePath = TestableFilePath
+	{ fromTestableFilePath :: FilePath }
+	deriving (Show)
+
+instance Arbitrary TestableFilePath where
+	arbitrary = (TestableFilePath . fromTestableString <$> arbitrary)
+		`suchThat` (not . null . fromTestableFilePath)
+		`suchThat` (not . any (== '\NUL') . fromTestableFilePath)
+
 {- Times before the epoch are excluded. Half with decimal and half without. -}
 instance Arbitrary POSIXTime where
 	arbitrary = do
diff --git a/Utility/RawFilePath.hs b/Utility/RawFilePath.hs
index 6a5f704..f32b226 100644
--- a/Utility/RawFilePath.hs
+++ b/Utility/RawFilePath.hs
@@ -1,4 +1,4 @@
-{- Portability shim around System.Posix.Files.ByteString
+{- Portability shim for basic operations on RawFilePaths.
  -
  - On unix, this makes syscalls using RawFilesPaths as efficiently as
  - possible.
@@ -7,38 +7,69 @@
  - decoded. So this library will work, but less efficiently than using
  - FilePath would.
  -
- - Copyright 2019 Joey Hess <id@joeyh.name>
+ - Copyright 2019-2020 Joey Hess <id@joeyh.name>
  -
  - License: BSD-2-clause
  -}
 
 {-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 
 module Utility.RawFilePath (
 	RawFilePath,
 	readSymbolicLink,
+	createSymbolicLink,
+	createLink,
+	removeLink,
 	getFileStatus,
 	getSymbolicLinkStatus,
 	doesPathExist,
+	getCurrentDirectory,
+	createDirectory,
+	setFileMode,
 ) where
 
 #ifndef mingw32_HOST_OS
 import Utility.FileSystemEncoding (RawFilePath)
 import System.Posix.Files.ByteString
+import qualified System.Posix.Directory.ByteString as D
 
+-- | Checks if a file or directory exists. Note that a dangling symlink
+-- will be false.
 doesPathExist :: RawFilePath -> IO Bool
 doesPathExist = fileExist
 
+getCurrentDirectory :: IO RawFilePath
+getCurrentDirectory = D.getWorkingDirectory
+
+createDirectory :: RawFilePath -> IO ()
+createDirectory p = D.createDirectory p 0o777
+
 #else
-import qualified Data.ByteString as B
-import System.PosixCompat (FileStatus)
+import System.PosixCompat (FileStatus, FileMode)
 import qualified System.PosixCompat as P
+import qualified System.PosixCompat.Files as F
 import qualified System.Directory as D
 import Utility.FileSystemEncoding
 
 readSymbolicLink :: RawFilePath -> IO RawFilePath
 readSymbolicLink f = toRawFilePath <$> P.readSymbolicLink (fromRawFilePath f)
 
+createSymbolicLink :: RawFilePath -> RawFilePath -> IO ()
+createSymbolicLink a b = P.createSymbolicLink
+	(fromRawFilePath a)
+	(fromRawFilePath b)
+
+createLink :: RawFilePath -> RawFilePath -> IO ()
+createLink a b = P.createLink
+	(fromRawFilePath a)
+	(fromRawFilePath b)
+
+{- On windows, removeLink is not available, so only remove files,
+ - not symbolic links. -}
+removeLink :: RawFilePath -> IO ()
+removeLink = D.removeFile . fromRawFilePath
+
 getFileStatus :: RawFilePath -> IO FileStatus
 getFileStatus = P.getFileStatus . fromRawFilePath
 
@@ -47,4 +78,13 @@ getSymbolicLinkStatus = P.getSymbolicLinkStatus . fromRawFilePath
 
 doesPathExist :: RawFilePath -> IO Bool
 doesPathExist = D.doesPathExist . fromRawFilePath
+
+getCurrentDirectory :: IO RawFilePath
+getCurrentDirectory = toRawFilePath <$> D.getCurrentDirectory
+
+createDirectory :: RawFilePath -> IO ()
+createDirectory = D.createDirectory . fromRawFilePath
+
+setFileMode :: RawFilePath -> FileMode -> IO () 
+setFileMode = F.setFileMode . fromRawFilePath
 #endif
diff --git a/Utility/Rsync.hs b/Utility/Rsync.hs
index c6881b7..e377eb9 100644
--- a/Utility/Rsync.hs
+++ b/Utility/Rsync.hs
@@ -114,7 +114,7 @@ rsyncUrlIsPath s
  -}
 rsyncProgress :: OutputHandler -> MeterUpdate -> [CommandParam] -> IO Bool
 rsyncProgress oh meter ps =
-	commandMeter' parseRsyncProgress oh meter "rsync" (rsyncParamsFixup ps) >>= \case
+	commandMeterExitCode parseRsyncProgress oh Nothing meter "rsync" (rsyncParamsFixup ps) >>= \case
 		Just ExitSuccess -> return True
 		Just (ExitFailure exitcode) -> do
 			when (exitcode /= 1) $
@@ -136,10 +136,10 @@ rsyncProgress oh meter ps =
 parseRsyncProgress :: ProgressParser
 parseRsyncProgress = go [] . reverse . progresschunks
   where
-	go remainder [] = (Nothing, remainder)
+	go remainder [] = (Nothing, Nothing, remainder)
 	go remainder (x:xs) = case parsebytes (findbytesstart x) of
 		Nothing -> go (delim:x++remainder) xs
-		Just b -> (Just (toBytesProcessed b), remainder)
+		Just b -> (Just (toBytesProcessed b), Nothing, remainder)
 
 	delim = '\r'
 
diff --git a/Utility/SafeCommand.hs b/Utility/SafeCommand.hs
index 19d5f20..6f9419c 100644
--- a/Utility/SafeCommand.hs
+++ b/Utility/SafeCommand.hs
@@ -16,18 +16,13 @@ module Utility.SafeCommand (
 	safeSystem,
 	safeSystem',
 	safeSystemEnv,
-	shellWrap,
-	shellEscape,
-	shellUnEscape,
 	segmentXargsOrdered,
 	segmentXargsUnordered,
-	prop_isomorphic_shellEscape,
-	prop_isomorphic_shellEscape_multiword,
 ) where
 
-import System.Exit
 import Utility.Process
-import Utility.Split
+
+import System.Exit
 import System.FilePath
 import Data.Char
 import Data.List
@@ -61,6 +56,8 @@ toCommand' (File s) = s
 
 -- | Run a system command, and returns True or False if it succeeded or failed.
 --
+-- (Throws an exception if the command is not found.)
+--
 -- This and other command running functions in this module log the commands
 -- run at debug level, using System.Log.Logger.
 boolSystem :: FilePath -> [CommandParam] -> IO Bool
@@ -81,9 +78,9 @@ safeSystem :: FilePath -> [CommandParam] -> IO ExitCode
 safeSystem command params = safeSystem' command params id
 
 safeSystem' :: FilePath -> [CommandParam] -> (CreateProcess -> CreateProcess) -> IO ExitCode
-safeSystem' command params mkprocess = do
-	(_, _, _, pid) <- createProcess p
-	waitForProcess pid
+safeSystem' command params mkprocess = 
+	withCreateProcess p $ \_ _ _ pid ->
+		waitForProcess pid
   where
 	p = mkprocess $ proc command (toCommand params)
 
@@ -91,44 +88,6 @@ safeSystemEnv :: FilePath -> [CommandParam] -> Maybe [(String, String)] -> IO Ex
 safeSystemEnv command params environ = safeSystem' command params $ 
 	\p -> p { env = environ }
 
--- | Wraps a shell command line inside sh -c, allowing it to be run in a
--- login shell that may not support POSIX shell, eg csh.
-shellWrap :: String -> String
-shellWrap cmdline = "sh -c " ++ shellEscape cmdline
-
--- | Escapes a filename or other parameter to be safely able to be exposed to
--- the shell.
---
--- This method works for POSIX shells, as well as other shells like csh.
-shellEscape :: String -> String
-shellEscape f = "'" ++ escaped ++ "'"
-  where
-	-- replace ' with '"'"'
-	escaped = intercalate "'\"'\"'" $ splitc '\'' f
-
--- | Unescapes a set of shellEscaped words or filenames.
-shellUnEscape :: String -> [String]
-shellUnEscape [] = []
-shellUnEscape s = word : shellUnEscape rest
-  where
-	(word, rest) = findword "" s
-	findword w [] = (w, "")
-	findword w (c:cs)
-		| c == ' ' = (w, cs)
-		| c == '\'' = inquote c w cs
-		| c == '"' = inquote c w cs
-		| otherwise = findword (w++[c]) cs
-	inquote _ w [] = (w, "")
-	inquote q w (c:cs)
-		| c == q = findword w cs
-		| otherwise = inquote q (w++[c]) cs
-
--- | For quickcheck.
-prop_isomorphic_shellEscape :: String -> Bool
-prop_isomorphic_shellEscape s = [s] == (shellUnEscape . shellEscape) s
-prop_isomorphic_shellEscape_multiword :: [String] -> Bool
-prop_isomorphic_shellEscape_multiword s = s == (shellUnEscape . unwords . map shellEscape) s
-
 -- | Segments a list of filenames into groups that are all below the maximum
 --  command-line length limit.
 segmentXargsOrdered :: [FilePath] -> [[FilePath]]
diff --git a/Utility/SimpleProtocol.hs b/Utility/SimpleProtocol.hs
new file mode 100644
index 0000000..acd2439
--- /dev/null
+++ b/Utility/SimpleProtocol.hs
@@ -0,0 +1,151 @@
+{- Simple line-based protocols.
+ -
+ - Copyright 2013-2020 Joey Hess <id@joeyh.name>
+ -
+ - License: BSD-2-clause
+ -}
+
+{-# LANGUAGE FlexibleInstances #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Utility.SimpleProtocol (
+	Sendable(..),
+	Receivable(..),
+	parseMessage,
+	Serializable(..),
+	Parser,
+	parseFail,
+	parse0,
+	parse1,
+	parse2,
+	parse3,
+	parse4,
+	parse5,
+	dupIoHandles,
+	getProtocolLine,
+) where
+
+import Data.Char
+import GHC.IO.Handle
+import Text.Read
+
+import Common
+
+-- Messages that can be sent.
+class Sendable m where
+	formatMessage :: m -> [String]
+
+-- Messages that can be received.
+class Receivable m where
+	-- Passed the first word of the message, returns
+	-- a Parser that can be be fed the rest of the message to generate
+	-- the value.
+	parseCommand :: String -> Parser m
+
+parseMessage :: (Receivable m) => String -> Maybe m
+parseMessage s = parseCommand command rest
+  where
+	(command, rest) = splitWord s
+
+class Serializable a where
+	serialize :: a -> String
+	deserialize :: String -> Maybe a
+
+instance Serializable [Char] where
+	serialize = id
+	deserialize = Just
+
+instance Serializable Integer where
+	serialize = show
+	deserialize = readMaybe
+
+instance Serializable ExitCode where
+	serialize ExitSuccess = "0"
+	serialize (ExitFailure n) = show n
+	deserialize "0" = Just ExitSuccess
+	deserialize s = ExitFailure <$> readMaybe s
+
+{- Parsing the parameters of messages. Using the right parseN ensures
+ - that the string is split into exactly the requested number of words,
+ - which allows the last parameter of a message to contain arbitrary
+ - whitespace, etc, without needing any special quoting.
+ -}
+type Parser a = String -> Maybe a
+
+parseFail :: Parser a
+parseFail _ = Nothing
+
+parse0 :: a -> Parser a
+parse0 mk "" = Just mk
+parse0 _ _ = Nothing
+
+parse1 :: Serializable p1 => (p1 -> a) -> Parser a
+parse1 mk p1 = mk <$> deserialize p1
+
+parse2 :: (Serializable p1, Serializable p2) => (p1 -> p2 -> a) -> Parser a
+parse2 mk s = mk <$> deserialize p1 <*> deserialize p2
+  where
+	(p1, p2) = splitWord s
+
+parse3 :: (Serializable p1, Serializable p2, Serializable p3) => (p1 -> p2 -> p3 -> a) -> Parser a
+parse3 mk s = mk <$> deserialize p1 <*> deserialize p2 <*> deserialize p3
+  where
+	(p1, rest) = splitWord s
+	(p2, p3) = splitWord rest
+
+parse4 :: (Serializable p1, Serializable p2, Serializable p3, Serializable p4) => (p1 -> p2 -> p3 -> p4 -> a) -> Parser a
+parse4 mk s = mk <$> deserialize p1 <*> deserialize p2 <*> deserialize p3 <*> deserialize p4
+  where
+	(p1, rest) = splitWord s
+	(p2, rest') = splitWord rest
+	(p3, p4) = splitWord rest'
+
+parse5 :: (Serializable p1, Serializable p2, Serializable p3, Serializable p4, Serializable p5) => (p1 -> p2 -> p3 -> p4 -> p5 -> a) -> Parser a
+parse5 mk s = mk <$> deserialize p1 <*> deserialize p2 <*> deserialize p3 <*> deserialize p4 <*> deserialize p5
+  where
+	(p1, rest) = splitWord s
+	(p2, rest') = splitWord rest
+	(p3, rest'') = splitWord rest'
+	(p4, p5) = splitWord rest''
+
+splitWord :: String -> (String, String)
+splitWord = separate isSpace
+
+{- When a program speaks a simple protocol over stdio, any other output
+ - to stdout (or anything that attempts to read from stdin)
+ - will mess up the protocol. To avoid that, close stdin,
+ - and duplicate stderr to stdout. Return two new handles
+ - that are duplicates of the original (stdin, stdout). -}
+dupIoHandles :: IO (Handle, Handle)
+dupIoHandles = do
+	readh <- hDuplicate stdin
+	writeh <- hDuplicate stdout
+	nullh <- openFile devNull ReadMode
+	nullh `hDuplicateTo` stdin
+	stderr `hDuplicateTo` stdout
+	return (readh, writeh)
+
+{- Reads a line, but to avoid super-long lines eating memory, returns
+ - Nothing if 32 kb have been read without seeing a '\n'
+ -
+ - If there is a '\r' before the '\n', it is removed, to support
+ - systems using "\r\n" at ends of lines 
+ -
+ - This implementation is not super efficient, but as long as the Handle
+ - supports buffering, it avoids reading a character at a time at the
+ - syscall level.
+ -
+ - Throws isEOFError when no more input is available.
+ -}
+getProtocolLine :: Handle -> IO (Maybe String)
+getProtocolLine h = go (32768 :: Int) []
+  where
+	go 0 _ = return Nothing
+	go n l = do
+		c <- hGetChar h
+		if c == '\n'
+			then return $ Just $ reverse $ 
+				case l of
+					('\r':rest) -> rest
+					_ -> l
+			else go (n-1) (c:l)
diff --git a/Utility/Tmp.hs b/Utility/Tmp.hs
index 6ee592b..5877f68 100644
--- a/Utility/Tmp.hs
+++ b/Utility/Tmp.hs
@@ -1,6 +1,6 @@
 {- Temporary files.
  -
- - Copyright 2010-2013 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2020 Joey Hess <id@joeyh.name>
  -
  - License: BSD-2-clause
  -}
@@ -20,16 +20,22 @@ import System.IO
 import System.FilePath
 import System.Directory
 import Control.Monad.IO.Class
-import System.PosixCompat.Files
+import System.PosixCompat.Files hiding (removeLink)
 
 import Utility.Exception
 import Utility.FileSystemEncoding
+import Utility.FileMode
 
 type Template = String
 
 {- Runs an action like writeFile, writing to a temp file first and
  - then moving it into place. The temp file is stored in the same
- - directory as the final file to avoid cross-device renames. -}
+ - directory as the final file to avoid cross-device renames.
+ -
+ - While this uses a temp file, the file will end up with the same
+ - mode as it would when using writeFile, unless the writer action changes
+ - it.
+ -}
 viaTmp :: (MonadMask m, MonadIO m) => (FilePath -> v -> m ()) -> FilePath -> v -> m ()
 viaTmp a file content = bracketIO setup cleanup use
   where
@@ -42,6 +48,11 @@ viaTmp a file content = bracketIO setup cleanup use
 		_ <- tryIO $ hClose h
 		tryIO $ removeFile tmpfile
 	use (tmpfile, h) = do
+		-- 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 $ hClose h
 		a tmpfile content
 		liftIO $ rename tmpfile file
@@ -54,7 +65,11 @@ withTmpFile template a = do
 	withTmpFileIn tmpdir template a
 
 {- Runs an action with a tmp file located in the specified directory,
- - then removes the file. -}
+ - then removes the file.
+ -
+ - Note that the tmp file will have a file mode that only allows the
+ - current user to access it.
+ -}
 withTmpFileIn :: (MonadIO m, MonadMask m) => FilePath -> Template -> (FilePath -> Handle -> m a) -> m a
 withTmpFileIn tmpdir template a = bracket create remove use
   where