use openTempFile from file-io

And follow-on changes.

Note that relatedTemplate was changed to operate on a RawFilePath, and
so when it counts the length, it is now the number of bytes, not the
number of code points. This will just make it truncate shorter strings
in some cases, the truncation is still unicode aware.

When not building with the OsPath flag, toOsPath . fromRawFilePath and
fromRawFilePath . fromOsPath do extra conversions back and forth between
String and ByteString. That overhead could be avoided, but that's the
non-optimised build mode, so didn't bother.

Sponsored-by: unqueued

Utility/FileIO.hs

@@ -22,6 +22,7 @@ module Utility.FileIO
 	writeFile',
 	appendFile,
 	appendFile',
+	openTempFile,
 ) where
 
 #ifdef WITH_OSPATH
@@ -81,6 +82,10 @@ appendFile' f b = do
 	f' <- toOsPath <$> convertToWindowsNativeNamespace (fromOsPath f)
 	O.appendFile' f' b
 
+openTempFile :: OsPath -> OsPath -> IO (OsPath, Handle)
+openTempFile p s = do
+	p' <- toOsPath <$> convertToWindowsNativeNamespace (fromOsPath p)
+	O.openTempFile p' s
 #endif
 
 #else
@@ -88,7 +93,8 @@ appendFile' f b = do
 -- instead. However, functions still use ByteString for the
 -- file content in that case, unlike the Strings used by the Prelude.
 import Utility.OsPath
-import System.IO (withFile, openFile, IO)
+import System.IO (withFile, openFile, openTempFile, IO)
+import qualified System.IO
 import Data.ByteString.Lazy (readFile, writeFile, appendFile)
 import qualified Data.ByteString as B
 

Utility/LockFile/PidLock.hs

@@ -40,6 +40,7 @@ import Utility.Env
 import Utility.Env.Set
 import Utility.Tmp
 import Utility.RawFilePath
+import Utility.OsPath
 import qualified Utility.LockFile.Posix as Posix
 
 import System.IO
@@ -149,9 +150,10 @@ tryLock lockfile = do
 		_ -> return (Just ParentLocked)
   where
 	go abslockfile sidelock = do
-		let abslockfile' = fromRawFilePath abslockfile
-		(tmp, h) <- openTmpFileIn (takeDirectory abslockfile') "locktmp"
-		let tmp' = toRawFilePath tmp
+		(tmp, h) <- openTmpFileIn 
+			(toOsPath (P.takeDirectory abslockfile)) 
+			(toOsPath "locktmp")
+		let tmp' = fromOsPath tmp
 		setFileMode tmp' (combineModes readModes)
 		hPutStr h . show =<< mkPidLock
 		hClose h

Utility/MoveFile.hs

@@ -28,6 +28,7 @@ import Utility.Tmp
 import Utility.Exception
 import Utility.Monad
 import Utility.FileSystemEncoding
+import Utility.OsPath
 import qualified Utility.RawFilePath as R
 import Author
 
@@ -40,11 +41,12 @@ moveFile src dest = tryIO (R.rename src dest) >>= onrename
 	onrename (Left e)
 		| isPermissionError e = rethrow
 		| isDoesNotExistError e = rethrow
-		| otherwise = viaTmp mv (fromRawFilePath dest) ()
+		| otherwise = viaTmp mv (toOsPath dest) ()
 	  where
 		rethrow = throwM e
 
 		mv tmp () = do
+			let tmp' = fromRawFilePath (fromOsPath tmp)
 			-- copyFile is likely not as optimised as
 			-- the mv command, so we'll use the command.
 			--
@@ -57,18 +59,18 @@ moveFile src dest = tryIO (R.rename src dest) >>= onrename
 			ok <- copyright =<< boolSystem "mv"
 				[ Param "-f"
 				, Param (fromRawFilePath src)
-				, Param tmp
+				, Param tmp'
 				]
 			let e' = e
 #else
-			r <- tryIO $ copyFile (fromRawFilePath src) tmp
+			r <- tryIO $ copyFile (fromRawFilePath 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
+				_ <- tryIO $ removeFile tmp'
 				throwM e'
 
 #ifndef mingw32_HOST_OS	

Utility/OsPath.hs

@@ -9,7 +9,12 @@
 {-# LANGUAGE PackageImports #-}
 {-# OPTIONS_GHC -fno-warn-tabs #-}
 
-module Utility.OsPath where
+module Utility.OsPath (
+	OsPath,
+	OsString,
+	toOsPath,
+	fromOsPath,
+) where
 
 import Utility.FileSystemEncoding
 
@@ -39,8 +44,11 @@ fromOsPath = S.fromShort . getPosixString . getOsString
 {- When not building with WITH_OSPATH, use FilePath. This allows
  - using functions from legacy FilePath libraries interchangeably with
  - newer OsPath libraries.
- - -}
+ -}
 type OsPath = FilePath
+
+type OsString = String
+
 toOsPath :: RawFilePath -> OsPath
 toOsPath = fromRawFilePath
 

Utility/SshConfig.hs

@@ -28,6 +28,7 @@ import Common
 import Utility.UserInfo
 import Utility.Tmp
 import Utility.FileMode
+import qualified Utility.FileIO as F
 
 import Data.Char
 import Data.Ord
@@ -140,12 +141,12 @@ changeUserSshConfig modifier = do
 			-- If it's a symlink, replace the file it
 			-- points to.
 			f <- catchDefaultIO configfile (canonicalizePath configfile)
-			viaTmp writeSshConfig f c'
+			viaTmp writeSshConfig (toOsPath (toRawFilePath f)) c'
 
-writeSshConfig :: FilePath -> String -> IO ()
+writeSshConfig :: OsPath -> String -> IO ()
 writeSshConfig f s = do
-	writeFile f s
-	setSshConfigMode (toRawFilePath f)
+	F.writeFile' f (encodeBS s)
+	setSshConfigMode (fromOsPath f)
 
 {- Ensure that the ssh config file lacks any group or other write bits, 
  - since ssh is paranoid about not working if other users can write

Utility/StatelessOpenPGP.hs

@@ -27,6 +27,7 @@ import System.Posix.Types
 import System.Posix.IO
 #else
 import Utility.Tmp
+import Utility.OsPath
 #endif
 import Utility.Tmp.Dir
 import Author
@@ -112,7 +113,7 @@ decryptSymmetric sopcmd password emptydirectory feeder reader =
 {- Test a value round-trips through symmetric encryption and decryption. -}
 test_encrypt_decrypt_Symmetric :: SOPCmd -> SOPCmd -> Password -> Armoring -> B.ByteString -> IO Bool
 test_encrypt_decrypt_Symmetric a b password armoring v = catchBoolIO $
-	withTmpDir "test" $ \d -> do
+	withTmpDir (toOsPath "test") $ \d -> do
 		let ed = EmptyDirectory d
 		enc <- encryptSymmetric a password ed Nothing armoring
 			(`B.hPutStr` v) B.hGetContents
@@ -159,7 +160,7 @@ feedRead cmd subcmd params password emptydirectory feeder reader = do
 		go (Just emptydirectory) (passwordfd ++ params)
 #else
 	-- store the password in a temp file
-	withTmpFile "sop" $ \tmpfile h -> do
+	withTmpFile (toOsPath "sop") $ \tmpfile h -> do
 		liftIO $ B.hPutStr h password
 		liftIO $ hClose h
 		let passwordfile = [Param $ "--with-password="++tmpfile]

Utility/Tmp.hs

@@ -5,7 +5,7 @@
  - License: BSD-2-clause
  -}
 
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# OPTIONS_GHC -fno-warn-tabs #-}
 
 module Utility.Tmp (
@@ -18,28 +18,31 @@ module Utility.Tmp (
 ) where
 
 import System.IO
-import System.FilePath
 import System.Directory
 import Control.Monad.IO.Class
 import System.IO.Error
+import qualified Data.ByteString as B
+import qualified System.FilePath.ByteString as P
 
 import Utility.Exception
 import Utility.FileSystemEncoding
 import Utility.FileMode
 import qualified Utility.RawFilePath as R
+import qualified Utility.FileIO as F
+import Utility.OsPath
 
-type Template = String
+type Template = OsString
 
 {- This is the same as openTempFile, except when there is an
  - error, it displays the template as well as the directory,
  - to help identify what call was responsible.
  -}
-openTmpFileIn :: FilePath -> String -> IO (FilePath, Handle)
-openTmpFileIn dir template = openTempFile dir template
+openTmpFileIn :: OsPath -> Template -> IO (OsPath, Handle)
+openTmpFileIn dir template = F.openTempFile dir template
 	`catchIO` decoraterrror
   where
 	decoraterrror e = throwM $
-		let loc = ioeGetLocation e ++ " template " ++ template
+		let loc = ioeGetLocation e ++ " template " ++ decodeBS (fromOsPath template)
 		in annotateIOError e loc Nothing Nothing
 
 {- Runs an action like writeFile, writing to a temp file first and
@@ -50,34 +53,36 @@ openTmpFileIn dir template = openTempFile dir template
  - 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 :: (MonadMask m, MonadIO m) => (OsPath -> v -> m ()) -> OsPath -> v -> m ()
 viaTmp a file content = bracketIO setup cleanup use
   where
-	(dir, base) = splitFileName file
-	template = relatedTemplate (base ++ ".tmp")
+	(dir, base) = P.splitFileName (fromOsPath file)
+	template = relatedTemplate (base <> ".tmp")
 	setup = do
-		createDirectoryIfMissing True dir
-		openTmpFileIn dir template
+		createDirectoryIfMissing True (fromRawFilePath dir)
+		openTmpFileIn (toOsPath dir) template
 	cleanup (tmpfile, h) = do
 		_ <- tryIO $ hClose h
-		tryIO $ removeFile tmpfile
+		tryIO $ R.removeLink (fromOsPath tmpfile)
 	use (tmpfile, h) = do
-		let tmpfile' = toRawFilePath tmpfile
+		let tmpfile' = fromOsPath 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 $ R.setFileMode tmpfile' =<< defaultFileMode
+		_ <- liftIO $ tryIO $
+			R.setFileMode (fromOsPath tmpfile)
+				=<< defaultFileMode
 		liftIO $ hClose h
 		a tmpfile content
-		liftIO $ R.rename tmpfile' (toRawFilePath file)
+		liftIO $ R.rename tmpfile' (fromOsPath 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. -}
-withTmpFile :: (MonadIO m, MonadMask m) => Template -> (FilePath -> Handle -> m a) -> m a
+withTmpFile :: (MonadIO m, MonadMask m) => Template -> (OsPath -> Handle -> m a) -> m a
 withTmpFile template a = do
 	tmpdir <- liftIO $ catchDefaultIO "." getTemporaryDirectory
-	withTmpFileIn tmpdir template a
+	withTmpFileIn (toOsPath (toRawFilePath tmpdir)) template a
 
 {- Runs an action with a tmp file located in the specified directory,
  - then removes the file.
@@ -85,13 +90,13 @@ withTmpFile template a = do
  - 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 :: (MonadIO m, MonadMask m) => OsPath -> Template -> (OsPath -> Handle -> m a) -> m a
 withTmpFileIn tmpdir template a = bracket create remove use
   where
 	create = liftIO $ openTmpFileIn tmpdir template
 	remove (name, h) = liftIO $ do
 		hClose h
-		catchBoolIO (removeFile name >> return True)
+		tryIO $ R.removeLink (fromOsPath name)
 	use (name, h) = a name h
 
 {- It's not safe to use a FilePath of an existing file as the template
@@ -103,14 +108,15 @@ withTmpFileIn tmpdir template a = bracket create remove use
  - anyway, which is enough for the current implementation and any
  - likely implementation.)
  -}
-relatedTemplate :: FilePath -> FilePath
+relatedTemplate :: RawFilePath -> Template
 relatedTemplate f
 	| len > 20 = 
 		{- Some filesystems like FAT have issues with filenames
 		 - ending in ".", so avoid truncating a filename to end
 		 - that way. -}
-		reverse $ dropWhile (== '.') $ reverse $
-			truncateFilePath (len - 20) f
-	| otherwise = f
+		toOsPath $ toRawFilePath $ 
+			reverse $ dropWhile (== '.') $ reverse $
+				truncateFilePath (len - 20) (fromRawFilePath f)
+	| otherwise = toOsPath f
   where
-	len = length f
+	len = B.length f

Utility/Tmp/Dir.hs

@@ -23,6 +23,8 @@ import System.Posix.Temp (mkdtemp)
 
 import Utility.Exception
 import Utility.Tmp (Template)
+import Utility.OsPath
+import Utility.FileSystemEncoding
 
 {- Runs an action with a tmp directory located within the system's tmp
  - directory (or within "." if there is none), then removes the tmp
@@ -33,7 +35,7 @@ withTmpDir template a = do
 #ifndef mingw32_HOST_OS
 	-- Use mkdtemp to create a temp directory securely in /tmp.
 	bracket
-		(liftIO $ mkdtemp $ topleveltmpdir </> template)
+		(liftIO $ mkdtemp $ topleveltmpdir </> fromRawFilePath (fromOsPath template))
 		removeTmpDir
 		a
 #else
@@ -47,7 +49,7 @@ withTmpDirIn tmpdir template = bracketIO create removeTmpDir
   where
 	create = do
 		createDirectoryIfMissing True tmpdir
-		makenewdir (tmpdir </> template) (0 :: Int)
+		makenewdir (tmpdir </> fromRawFilePath (fromOsPath template)) (0 :: Int)
 	makenewdir t n = do
 		let dir = t ++ "." ++ show n
 		catchIOErrorType AlreadyExists (const $ makenewdir t $ n + 1) $ do

Utility/WebApp.hs

@@ -187,7 +187,9 @@ insertAuthToken extractAuthToken predicate webapp root pathbits params =
  - to avoid exposing the secret token when launching the web browser. -}
 writeHtmlShim :: String -> String -> FilePath -> IO ()
 writeHtmlShim title url file = 
-	viaTmp (writeFileProtected . toRawFilePath) file $ genHtmlShim title url
+	viaTmp (writeFileProtected . fromOsPath)
+		(toOsPath $ toRawFilePath file) 
+		(genHtmlShim title url)
 
 genHtmlShim :: String -> String -> String
 genHtmlShim title url = unlines