Windows: Support long filenames in more (possibly all) of the code

Works around this bug in unix-compat:
https://github.com/jacobstanley/unix-compat/issues/56
getFileStatus and other FilePath using functions in unix-compat do not do
UNC conversion on Windows.

Made Utility.RawFilePath use convertToWindowsNativeNamespace to do the
necessary conversion on windows to support long filenames.

Audited all imports of System.PosixCompat.Files to make sure that no
functions that operate on FilePath were imported from it. Instead, use
the equvilants from Utility.RawFilePath. In particular the
re-export of that module in Common had to be removed, which led to lots
of other changes throughout the code.

The changes to Build.Configure, Build.DesktopFile, and Build.TestConfig
make Utility.Directory not be needed to build setup. And so let it use
Utility.RawFilePath, which depends on unix, which cannot be in
setup-depends.

Sponsored-by: Dartmouth College's Datalad project

Annex/AutoMerge.hs

@@ -39,6 +39,7 @@ import qualified Utility.RawFilePath as R
 import qualified Data.Set as S
 import qualified Data.Map as M
 import qualified Data.ByteString.Lazy as L
+import System.PosixCompat.Files (isSymbolicLink)
 
 {- Merges from a branch into the current branch (which may not exist yet),
  - with automatic merge conflict resolution.

Annex/Content.hs

@@ -104,6 +104,7 @@ import Utility.Metered
 import qualified Utility.RawFilePath as R
 
 import qualified System.FilePath.ByteString as P
+import System.PosixCompat.Files (isSymbolicLink, linkCount)
 
 {- Prevents the content from being removed while the action is running.
  - Uses a shared lock.

Annex/Content/LowLevel.hs

@@ -19,6 +19,7 @@ import Utility.CopyFile
 import qualified Utility.RawFilePath as R
 
 import qualified System.FilePath.ByteString as P
+import System.PosixCompat.Files (linkCount)
 
 {- Runs the secure erase command if set, otherwise does nothing.
  - File may or may not be deleted at the end; caller is responsible for

Annex/Content/PointerFile.hs

@@ -22,6 +22,8 @@ import Utility.Touch
 import qualified System.Posix.Files as Posix
 #endif
 
+import System.PosixCompat.Files (fileMode)
+
 {- Populates a pointer file with the content of a key. 
  -
  - If the file already has some other content, it is not modified.
@@ -53,12 +55,11 @@ populatePointerFile restage k obj f = go =<< liftIO (isPointerFile f)
  - Does not check if the pointer file is modified. -}
 depopulatePointerFile :: Key -> RawFilePath -> Annex ()
 depopulatePointerFile key file = do
-	let file' = fromRawFilePath file
-	st <- liftIO $ catchMaybeIO $ getFileStatus file'
+	st <- liftIO $ catchMaybeIO $ R.getFileStatus file
 	let mode = fmap fileMode st
 	secureErase file
 	liftIO $ removeWhenExistsWith R.removeLink file
-	ic <- replaceWorkTreeFile file' $ \tmp -> do
+	ic <- replaceWorkTreeFile (fromRawFilePath file) $ \tmp -> do
 		let tmp' = toRawFilePath tmp
 		liftIO $ writePointerFile tmp' key mode
 #if ! defined(mingw32_HOST_OS)

Annex/CopyFile.hs

@@ -15,10 +15,12 @@ import Utility.CopyFile
 import Utility.FileMode
 import Utility.Touch
 import Utility.Hash (IncrementalVerifier(..))
+import qualified Utility.RawFilePath as R
 
 import Control.Concurrent
 import qualified Data.ByteString as S
 import Data.Time.Clock.POSIX
+import System.PosixCompat.Files (fileMode)
 
 -- To avoid the overhead of trying copy-on-write every time, it's tried
 -- once and if it fails, is not tried again.
@@ -101,9 +103,9 @@ fileCopier copycowtried src dest meterupdate iv =
 			fileContentCopier hsrc dest meterupdate iv
 		
 		-- Copy src mode and mtime.
-		mode <- fileMode <$> getFileStatus src
+		mode <- fileMode <$> R.getFileStatus (toRawFilePath src)
 		mtime <- utcTimeToPOSIXSeconds <$> getModificationTime src
-		setFileMode dest mode
+		R.setFileMode dest' mode
 		touch dest' mtime False
 
 		return Copied

Annex/Ingest.hs

@@ -51,6 +51,8 @@ import Annex.AdjustedBranch
 import Annex.FileMatcher
 import qualified Utility.RawFilePath as R
 
+import System.PosixCompat.Files (fileMode)
+
 data LockedDown = LockedDown
 	{ lockDownConfig :: LockDownConfig
 	, keySource :: KeySource
@@ -120,11 +122,12 @@ lockDown' cfg file = tryNonAsync $ ifM crippledFileSystem
 				`catchIO` const (nohardlink' delta)
 
 	withhardlink' delta tmpfile = do
-		createLink file tmpfile
-		cache <- genInodeCache (toRawFilePath tmpfile) delta
+		let tmpfile' = toRawFilePath tmpfile
+		R.createLink file' tmpfile'
+		cache <- genInodeCache tmpfile' delta
 		return $ LockedDown cfg $ KeySource
 			{ keyFilename = file'
-			, contentLocation = toRawFilePath tmpfile
+			, contentLocation = tmpfile'
 			, inodeCache = cache
 			}
 		

Annex/Init.hs

@@ -62,6 +62,7 @@ import qualified Utility.LockFile.Posix as Posix
 
 import qualified Data.Map as M
 import Control.Monad.IO.Class (MonadIO)
+import System.PosixCompat.Files (ownerReadMode, isNamedPipe)
 #ifndef mingw32_HOST_OS
 import Data.Either
 import qualified System.FilePath.ByteString as P
@@ -296,7 +297,7 @@ probeCrippledFileSystem' tmp freezecontent thawcontent hasfreezehook = do
 	probe f = catchDefaultIO (True, []) $ do
 		let f2 = f ++ "2"
 		liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath f2)
-		liftIO $ createSymbolicLink f f2
+		liftIO $ R.createSymbolicLink (toRawFilePath f) (toRawFilePath f2)
 		liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath f2)
 		(fromMaybe (liftIO . preventWrite) freezecontent) (toRawFilePath f)
 		-- Should be unable to write to the file (unless
@@ -372,7 +373,7 @@ probeFifoSupport = do
 			removeWhenExistsWith R.removeLink f
 			removeWhenExistsWith R.removeLink f2
 			ms <- tryIO $ do
-				createNamedPipe (fromRawFilePath f) ownerReadMode
+				R.createNamedPipe f ownerReadMode
 				R.createLink f f2
 				R.getFileStatus f
 			removeWhenExistsWith R.removeLink f

Annex/Link.hs

@@ -43,6 +43,7 @@ import qualified Data.ByteString as S
 import qualified Data.ByteString.Char8 as S8
 import qualified Data.ByteString.Lazy as L
 import qualified System.FilePath.ByteString as P
+import System.PosixCompat.Files (isSymbolicLink)
 
 type LinkTarget = S.ByteString
 

Annex/Perms.hs

@@ -44,6 +44,8 @@ import Config
 import Utility.Directory.Create
 import qualified Utility.RawFilePath as R
 
+import System.PosixCompat.Files (fileMode, intersectFileModes, nullFileMode, groupWriteMode, ownerWriteMode, ownerReadMode, groupReadMode, stdFileMode, ownerExecuteMode, groupExecuteMode)
+
 withShared :: (SharedRepository -> Annex a) -> Annex a
 withShared a = a =<< coreSharedRepository <$> Annex.getGitConfig
 

Annex/Tmp.hs

@@ -15,6 +15,7 @@ import Types.CleanupActions
 import qualified Utility.RawFilePath as R
 
 import Data.Time.Clock.POSIX
+import System.PosixCompat.Files (modificationTime)
 
 -- | For creation of tmp files, other than for key's contents.
 --
@@ -66,7 +67,7 @@ cleanupOtherTmp = do
 	cleanold f = do
 		now <- liftIO getPOSIXTime
 		let oldenough = now - (60 * 60 * 24 * 7)
-		catchMaybeIO (modificationTime <$> getSymbolicLinkStatus f) >>= \case
+		catchMaybeIO (modificationTime <$> R.getSymbolicLinkStatus (toRawFilePath f)) >>= \case
 			Just mtime | realToFrac mtime <= oldenough -> 
 				void $ tryIO $ removeWhenExistsWith R.removeLink (toRawFilePath f)
 			_ -> return ()

Assistant/Install.hs

@@ -27,6 +27,8 @@ import Utility.UserInfo
 import Utility.Android
 #endif
 
+import System.PosixCompat.Files (ownerExecuteMode)
+
 standaloneAppBase :: IO (Maybe FilePath)
 standaloneAppBase = getEnv "GIT_ANNEX_APP_BASE"
 

Assistant/Threads/Committer.hs

@@ -40,12 +40,14 @@ import qualified Database.Keys
 import qualified Command.Sync
 import Utility.Tuple
 import Utility.Metered
+import qualified Utility.RawFilePath as R
 
 import Data.Time.Clock
 import qualified Data.Set as S
 import qualified Data.Map as M
 import Data.Either
 import Control.Concurrent
+import System.PosixCompat.Files (fileID, deviceID, fileMode)
 
 {- This thread makes git commits at appropriate times. -}
 commitThread :: NamedThread
@@ -358,7 +360,7 @@ handleAdds lockdowndir havelsof largefilematcher delayadd cs = returnWhen (null
 
 	done change file key = liftAnnex $ do
 		logStatus key InfoPresent
-		mode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus file
+		mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus (toRawFilePath file)
 		stagePointerFile (toRawFilePath file) mode =<< hashPointerFile key
 		showEndOk
 		return $ Just $ finishedChange change key
@@ -367,8 +369,8 @@ handleAdds lockdowndir havelsof largefilematcher delayadd cs = returnWhen (null
 	 - and is still a hard link to its contentLocation,
 	 - before ingesting it. -}
 	sanitycheck keysource a = do
-		fs <- liftIO $ getSymbolicLinkStatus $ fromRawFilePath $ keyFilename keysource
-		ks <- liftIO $ getSymbolicLinkStatus $ fromRawFilePath $ contentLocation keysource
+		fs <- liftIO $ R.getSymbolicLinkStatus $ keyFilename keysource
+		ks <- liftIO $ R.getSymbolicLinkStatus $ contentLocation keysource
 		if deviceID ks == deviceID fs && fileID ks == fileID fs
 			then a
 			else do

Assistant/Threads/SanityChecker.hs

@@ -53,6 +53,7 @@ import Utility.DiskFree
 
 import Data.Time.Clock.POSIX
 import qualified Data.Text as T
+import System.PosixCompat.Files (statusChangeTime, isSymbolicLink)
 
 {- This thread runs once at startup, and most other threads wait for it
  - to finish. (However, the webapp thread does not, to prevent the UI
@@ -156,11 +157,10 @@ dailyCheck urlrenderer = do
 	(unstaged, cleanup) <- liftIO $ Git.LsFiles.notInRepo [] False ["."] g
 	now <- liftIO getPOSIXTime
 	forM_ unstaged $ \file -> do
-		let file' = fromRawFilePath file
-		ms <- liftIO $ catchMaybeIO $ getSymbolicLinkStatus file'
+		ms <- liftIO $ catchMaybeIO $ R.getSymbolicLinkStatus file
 		case ms of
 			Just s	| toonew (statusChangeTime s) now -> noop
-				| isSymbolicLink s -> addsymlink file' ms
+				| isSymbolicLink s -> addsymlink (fromRawFilePath file) ms
 			_ -> noop
 	liftIO $ void cleanup
 

Assistant/Threads/Watcher.hs

@@ -51,6 +51,7 @@ import Data.Typeable
 import qualified Data.ByteString.Lazy as L
 import qualified Control.Exception as E
 import Data.Time.Clock
+import System.PosixCompat.Files (fileMode, statusChangeTime)
 
 checkCanWatch :: Annex ()
 checkCanWatch
@@ -218,7 +219,7 @@ onAddFile symlinkssupported f fs = do
 		unlessM (inAnnex oldkey) $
 			logStatus oldkey InfoMissing
 	addlink file key = do
-		mode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus file
+		mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus (toRawFilePath file)
 		liftAnnex $ stagePointerFile (toRawFilePath file) mode =<< hashPointerFile key
 		madeChange file $ LinkChange (Just key)
 

Assistant/Upgrade.hs

@@ -222,7 +222,7 @@ upgradeToDistribution newdir cleanup distributionfile = do
 	makeorigsymlink olddir = do
 		let origdir = fromRawFilePath (parentDir (toRawFilePath olddir)) </> installBase
 		removeWhenExistsWith R.removeLink (toRawFilePath origdir)
-		createSymbolicLink newdir origdir
+		R.createSymbolicLink (toRawFilePath newdir) (toRawFilePath origdir)
 
 {- Finds where the old version was installed. -}
 oldVersionLocation :: IO FilePath

Assistant/WebApp/Configurators/Local.hs

@@ -40,6 +40,7 @@ import qualified Remote.GCrypt as GCrypt
 import qualified Types.Remote
 import Utility.Android
 import Types.ProposedAccepted
+import qualified Utility.RawFilePath as R
 
 import qualified Data.Text as T
 import qualified Data.Map as M
@@ -421,7 +422,7 @@ canWrite dir = do
 		( return dir
 		, return $ fromRawFilePath $ parentDir $ toRawFilePath dir
 		)
-	catchBoolIO $ fileAccess tocheck False True False
+	catchBoolIO $ R.fileAccess (toRawFilePath tocheck) False True False
 
 {- Gets the UUID of the git repo at a location, which may not exist, or
  - not be a git-annex repo. -}

Backend/WORM.hs

@@ -14,10 +14,11 @@ import Types.KeySource
 import Backend.Utilities
 import Git.FilePath
 import Utility.Metered
+import qualified Utility.RawFilePath as R
 
 import qualified Data.ByteString.Char8 as S8
-import qualified Utility.RawFilePath as R
 import qualified Data.ByteString.Short as S (toShort, fromShort)
+import System.PosixCompat.Files (modificationTime)
 
 backends :: [Backend]
 backends = [backend]

Build/Configure.hs

@@ -10,7 +10,7 @@ import Build.Version
 import Utility.SafeCommand
 import Utility.Env.Basic
 import qualified Git.Version
-import Utility.Directory
+import Utility.SystemDirectory
 
 import Control.Monad
 import Control.Applicative

Build/DesktopFile.hs

@@ -15,7 +15,7 @@ import Utility.Exception
 import Utility.FreeDesktop
 import Utility.Path
 import Utility.Monad
-import Utility.Directory
+import Utility.SystemDirectory
 import Utility.FileSystemEncoding
 import Config.Files
 import Utility.OSX

Build/TestConfig.hs

@@ -7,7 +7,7 @@ module Build.TestConfig where
 import Utility.Path
 import Utility.Monad
 import Utility.SafeCommand
-import Utility.Directory
+import Utility.SystemDirectory
 
 import System.IO
 import System.FilePath

CHANGELOG

@@ -4,6 +4,7 @@ git-annex (10.20230228) UNRELEASED; urgency=medium
     view branch, will enter an adjusted view branch.
   * status: This command is deprecated because it was only needed in direct
     mode; git status --short is very similar.
+  * Windows: Support long filenames in more (possibly all) of the code.
 
  -- Joey Hess <id@joeyh.name>  Mon, 27 Feb 2023 12:31:14 -0400
 

CmdLine/Seek.hs

@@ -52,6 +52,7 @@ import Control.Concurrent.STM
 import System.Posix.Types
 import Data.IORef
 import Data.Time.Clock.POSIX
+import System.PosixCompat.Files (isDirectory, isSymbolicLink, deviceID, fileID)
 import qualified System.FilePath.ByteString as P
 
 data AnnexedFileSeeker = AnnexedFileSeeker
@@ -114,7 +115,7 @@ withPathContents a params = do
 	-- fail if the path that the user provided is a broken symlink,
 	-- the same as it fails if the path that the user provided does not
 	-- exist.
-	get p = ifM (isDirectory <$> getFileStatus p)
+	get p = ifM (isDirectory <$> R.getFileStatus p')
 		( map (\f -> 
 			let f' = toRawFilePath f
 			in (f', P.makeRelative (P.takeDirectory (P.dropTrailingPathSeparator p')) f'))
@@ -562,8 +563,9 @@ workTreeItems' (AllowHidden allowhidden) ww ps = case ww of
 		currbranch <- getCurrentBranch
 		stopattop <- prepviasymlink
 		ps' <- flip filterM ps $ \p -> do
-			relf <- liftIO $ relPathCwdToFile $ toRawFilePath p
-			ifM (not <$> (exists p <||> hidden currbranch relf))
+			let p' = toRawFilePath p
+			relf <- liftIO $ relPathCwdToFile p'
+			ifM (not <$> (exists p' <||> hidden currbranch relf))
 				( prob (p ++ " not found")
 				, ifM (viasymlink stopattop (upFrom relf))
 					( prob (p ++ " is beyond a symbolic link")
@@ -574,7 +576,7 @@ workTreeItems' (AllowHidden allowhidden) ww ps = case ww of
 			then return NoWorkTreeItems
 			else return (WorkTreeItems ps')
 	
-	exists p = isJust <$> liftIO (catchMaybeIO $ getSymbolicLinkStatus p)
+	exists p = isJust <$> liftIO (catchMaybeIO $ R.getSymbolicLinkStatus p)
 
 	prepviasymlink = do
 		repotopst <- inRepo $ 

Command/Add.hs

@@ -31,7 +31,7 @@ import Annex.CheckIgnore
 import qualified Utility.RawFilePath as R
 import qualified System.FilePath.ByteString as P
 
-import System.PosixCompat.Files (fileSize)
+import System.PosixCompat.Files (fileSize, isSymbolicLink, isRegularFile, modificationTime, fileID, deviceID, fileMode, ownerExecuteMode, intersectFileModes)
 
 cmd :: Command
 cmd = notBareRepo $ 

Command/Fix.hs

@@ -19,9 +19,10 @@ import Annex.Link
 import qualified Database.Keys
 import qualified Utility.RawFilePath as R
 
+import System.PosixCompat.Files (fileMode, linkCount)
 #if ! defined(mingw32_HOST_OS)
-import Utility.Touch
 import qualified System.Posix.Files as Posix
+import Utility.Touch
 #endif
 
 cmd :: Command

Command/Fsck.hs

@@ -49,6 +49,7 @@ import qualified Data.Set as S
 import qualified Data.Map as M
 import Data.Either
 import qualified System.FilePath.ByteString as P
+import System.PosixCompat.Files (fileMode, isSymbolicLink, modificationTime)
 
 cmd :: Command
 cmd = withAnnexOptions [jobsOption, jsonOptions, annexedMatchingOptions] $

Command/FuzzTest.hs

@@ -274,4 +274,4 @@ newDir parent = go (100 :: Int)
 			)
 
 doesnotexist :: FilePath -> IO Bool
-doesnotexist f = isNothing <$> catchMaybeIO (getSymbolicLinkStatus f)
+doesnotexist f = isNothing <$> catchMaybeIO (R.getSymbolicLinkStatus (toRawFilePath f))

Command/Import.hs

@@ -37,6 +37,7 @@ import Utility.Metered
 import qualified Utility.RawFilePath as R
 
 import Control.Concurrent.STM
+import System.PosixCompat.Files (isDirectory, isSymbolicLink, isRegularFile)
 
 cmd :: Command
 cmd = notBareRepo $

Command/ImportFeed.hs

@@ -50,6 +50,7 @@ import Command.AddUrl (addWorkTree, checkRaw)
 import Annex.UntrustedFilePath
 import qualified Annex.Branch
 import Logs
+import qualified Utility.RawFilePath as R
 
 cmd :: Command
 cmd = notBareRepo $ withAnnexOptions [backendOption] $
@@ -312,7 +313,7 @@ performDownload' started addunlockedmatcher opts cache todownload = case locatio
 				let (d, base) = splitFileName file
 				in d </> show n ++ "_" ++ base
 		tryanother = makeunique url (n + 1) file
-		alreadyexists = liftIO $ isJust <$> catchMaybeIO (getSymbolicLinkStatus f)
+		alreadyexists = liftIO $ isJust <$> catchMaybeIO (R.getSymbolicLinkStatus (toRawFilePath f))
 		checksameurl k = ifM (elem url <$> getUrls k)
 			( return Nothing
 			, tryanother

Command/Info.hs

@@ -13,6 +13,7 @@ import "mtl" Control.Monad.State.Strict
 import qualified Data.Map.Strict as M
 import qualified Data.Vector as V
 import qualified System.FilePath.ByteString as P
+import System.PosixCompat.Files (isDirectory)
 import Data.Ord
 import qualified Data.Semigroup as Sem
 import Prelude
@@ -47,6 +48,7 @@ import qualified Limit
 import Messages.JSON (DualDisp(..), ObjectMap(..))
 import Annex.BloomFilter
 import qualified Command.Unused
+import qualified Utility.RawFilePath as R
 
 -- a named computation that produces a statistic
 type Stat = StatState (Maybe (String, StatState String))
@@ -163,7 +165,7 @@ autoenableInfo = showCustom "info" (SeekInput []) $ do
 	return True
 
 itemInfo :: InfoOptions -> (SeekInput, String) -> Annex ()
-itemInfo o (si, p) = ifM (isdir p)
+itemInfo o (si, p) = ifM (isdir (toRawFilePath p))
 	( dirInfo o p si
 	, Remote.byName' p >>= \case
 		Right r -> remoteInfo o r si
@@ -177,7 +179,7 @@ itemInfo o (si, p) = ifM (isdir p)
 			(_us, msg) -> noInfo p si msg
 	)
   where
-	isdir = liftIO . catchBoolIO . (isDirectory <$$> getFileStatus)
+	isdir = liftIO . catchBoolIO . (isDirectory <$$> R.getFileStatus)
 
 noInfo :: String -> SeekInput -> String -> Annex ()
 noInfo s si msg = do

Command/Lock.hs

@@ -21,6 +21,8 @@ import Logs.Location
 import Git.FilePath
 import qualified Utility.RawFilePath as R
 
+import System.PosixCompat.Files (linkCount)
+	
 cmd :: Command
 cmd = withAnnexOptions [jsonOptions, annexedMatchingOptions] $
 	command "lock" SectionCommon

Command/ReKey.hs

@@ -20,6 +20,8 @@ import Annex.WorkTree
 import Utility.InodeCache
 import qualified Utility.RawFilePath as R
 
+import System.PosixCompat.Files (linkCount, fileMode)
+
 cmd :: Command
 cmd = command "rekey" SectionPlumbing
 	"change keys used for files"

Command/Unannex.hs

@@ -19,6 +19,8 @@ import Annex.InodeSentinal
 import Git.FilePath
 import qualified Utility.RawFilePath as R
 
+import System.PosixCompat.Files (linkCount)
+
 cmd :: Command
 cmd = withAnnexOptions [annexedMatchingOptions] $
 	command "unannex" SectionUtility

Command/Uninit.hs

@@ -22,6 +22,8 @@ import Annex.WorkTree
 import Utility.FileMode
 import qualified Utility.RawFilePath as R
 
+import System.PosixCompat.Files (linkCount)
+
 cmd :: Command
 cmd = addCheck check $ 
 	command "uninit" SectionUtility

Command/Unlock.hs

@@ -18,6 +18,8 @@ import Git.FilePath
 import qualified Database.Keys
 import qualified Utility.RawFilePath as R
 
+import System.PosixCompat.Files (fileMode)
+
 cmd :: Command
 cmd = mkcmd "unlock" "unlock files for modification"
 

Common.hs

@@ -13,7 +13,7 @@ import Data.Default as X
 import System.FilePath as X
 import System.IO as X hiding (FilePath)
 import System.Exit as X
-import System.PosixCompat.Files as X hiding (fileSize, removeLink, rename)
+import System.PosixCompat.Files as X (FileStatus)
 
 import Utility.Misc as X
 import Utility.Exception as X

Git/Hook.hs

@@ -14,6 +14,9 @@ import Git
 import Utility.Tmp
 import Utility.Shell
 import Utility.FileMode
+import qualified Utility.RawFilePath as R
+
+import System.PosixCompat.Files (fileMode)
 
 data Hook = Hook
 	{ hookName :: FilePath
@@ -88,7 +91,7 @@ hookExists h r = do
 	let f = hookFile h r
 	catchBoolIO $
 #ifndef mingw32_HOST_OS
-		isExecutable . fileMode <$> getFileStatus f
+		isExecutable . fileMode <$> R.getFileStatus (toRawFilePath f)
 #else
 		doesFileExist f
 #endif

Limit.hs

@@ -45,6 +45,7 @@ import Data.Time.Clock.POSIX
 import qualified Data.Set as S
 import qualified Data.Map as M
 import qualified System.FilePath.ByteString as P
+import System.PosixCompat.Files (accessTime, isSymbolicLink)
 
 {- Some limits can look at the current status of files on
  - disk, or in the annex. This allows controlling which happens. -}
@@ -272,7 +273,7 @@ matchLockStatus wantlocked (MatchingFile fi) = liftIO $ do
 	islocked <- isPointerFile f >>= \case
 		Just _key -> return False
 		Nothing -> isSymbolicLink
-			<$> getSymbolicLinkStatus (fromRawFilePath f)
+			<$> R.getSymbolicLinkStatus f
 	return (islocked == wantlocked)
 matchLockStatus wantlocked (MatchingInfo p) = 
 	pure $ case providedLinkType p of

P2P/Address.hs

@@ -14,8 +14,10 @@ import Git.Types
 import Creds
 import Utility.AuthToken
 import Utility.Tor
+import qualified Utility.RawFilePath as R
 
 import qualified Data.Text as T
+import System.PosixCompat.Files (fileOwner, fileGroup)
 
 -- | A P2P address, without an AuthToken.
 --
@@ -80,8 +82,9 @@ storeP2PAddress addr = do
 		-- This may be run by root, so make the creds file
 		-- and directory have the same owner and group as
 		-- the git repository directory has.
-		st <- liftIO . getFileStatus =<< Annex.fromRepo repoLocation
-		let fixowner f = setOwnerAndGroup f (fileOwner st) (fileGroup st)
+		st <- liftIO . R.getFileStatus . toRawFilePath
+			=<< Annex.fromRepo repoLocation
+		let fixowner f = R.setOwnerAndGroup (toRawFilePath f) (fileOwner st) (fileGroup st)
 		liftIO $ do
 			fixowner tmpf
 			fixowner (takeDirectory tmpf)

P2P/IO.hs

@@ -50,6 +50,7 @@ import Control.Concurrent.STM
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as L
 import qualified Network.Socket as S
+import System.PosixCompat.Files (groupReadMode, groupWriteMode, otherReadMode, otherWriteMode)
 
 -- Type of interpreters of the Proto free monad.
 type RunProto m = forall a. Proto a -> m (Either ProtoFailure a)

Remote/Ddar.hs

@@ -14,6 +14,7 @@ module Remote.Ddar (remote) where
 import qualified Data.Map as M
 import qualified Data.ByteString.Lazy as L
 import System.IO.Error
+import System.PosixCompat.Files (isDirectory)
 
 import Annex.Common
 import Types.Remote
@@ -28,6 +29,7 @@ import Annex.Ssh
 import Annex.UUID
 import Utility.SshHost
 import Types.ProposedAccepted
+import qualified Utility.RawFilePath as R
 
 data DdarRepo = DdarRepo
 	{ ddarRepoConfig :: RemoteGitConfig
@@ -185,7 +187,7 @@ ddarDirectoryExists :: DdarRepo -> Annex (Either String Bool)
 ddarDirectoryExists ddarrepo
 	| ddarLocal ddarrepo = do
 		maybeStatus <- liftIO $ tryJust (guard . isDoesNotExistError) $
-			getSymbolicLinkStatus $ ddarRepoLocation ddarrepo
+			R.getSymbolicLinkStatus $ toRawFilePath $ ddarRepoLocation ddarrepo
 		return $ case maybeStatus of
 			Left _ -> Right False
 			Right status -> Right $ isDirectory status

Remote/Directory.hs

@@ -19,6 +19,7 @@ import qualified Data.ByteString.Lazy as L
 import qualified Data.Map as M
 import qualified System.FilePath.ByteString as P
 import Data.Default
+import System.PosixCompat.Files (isRegularFile, getFdStatus, deviceID)
 
 import Annex.Common
 import Types.Remote
@@ -254,7 +255,7 @@ retrieveKeyFileCheapM _ (LegacyChunks _) = Nothing
 retrieveKeyFileCheapM d NoChunks = Just $ \k _af f -> liftIO $ do
 	file <- fromRawFilePath <$> (absPath =<< getLocation d k)
 	ifM (doesFileExist file)
-		( createSymbolicLink file f
+		( R.createSymbolicLink (toRawFilePath file) (toRawFilePath f)
 		, giveup "content file not present in remote"
 		)
 #else
@@ -522,7 +523,7 @@ storeExportWithContentIdentifierM ii dir cow src _k loc overwritablecids p = do
 		void $ liftIO $ fileCopier cow src tmpf p Nothing
 		let tmpf' = toRawFilePath tmpf
 		resetAnnexFilePerm tmpf'
-		liftIO (getSymbolicLinkStatus tmpf) >>= liftIO . mkContentIdentifier ii tmpf' >>= \case
+		liftIO (R.getSymbolicLinkStatus tmpf') >>= liftIO . mkContentIdentifier ii tmpf' >>= \case
 			Nothing -> giveup "unable to generate content identifier"
 			Just newcid -> do
 				checkExportContent ii dir loc

Remote/Git.hs

@@ -700,7 +700,7 @@ type FileCopier = FilePath -> FilePath -> Key -> MeterUpdate -> Annex Bool -> Ve
 mkFileCopier :: Bool -> State -> Annex FileCopier
 mkFileCopier remotewanthardlink (State _ _ copycowtried _ _) = do
 	localwanthardlink <- wantHardLink
-	let linker = \src dest -> createLink src dest >> return True
+	let linker = \src dest -> R.createLink (toRawFilePath src) (toRawFilePath dest) >> return True
 	if remotewanthardlink || localwanthardlink
 		then return $ \src dest k p check verifyconfig ->
 			ifM (liftIO (catchBoolIO (linker src dest)))

Remote/Helper/Git.hs

@@ -11,8 +11,10 @@ import Annex.Common
 import qualified Git
 import Types.Availability
 import qualified Types.Remote as Remote
+import qualified Utility.RawFilePath as R
 
 import Data.Time.Clock.POSIX
+import System.PosixCompat.Files (modificationTime)
 
 repoCheap :: Git.Repo -> Bool
 repoCheap = not . Git.repoIsUrl
@@ -37,7 +39,7 @@ guardUsable r fallback a
 gitRepoInfo :: Remote -> Annex [(String, String)]
 gitRepoInfo r = do
 	d <- fromRawFilePath <$> fromRepo Git.localGitDir
-	mtimes <- liftIO $ mapM (modificationTime <$$> getFileStatus)
+	mtimes <- liftIO $ mapM (\p -> modificationTime <$> R.getFileStatus (toRawFilePath p))
 		=<< dirContentsRecursive (d </> "refs" </> "remotes" </> Remote.name r)
 	let lastsynctime = case mtimes of
 		[] -> "never"

Test.hs

@@ -26,9 +26,9 @@ import Control.Concurrent.STM hiding (check)
 
 import Common
 import CmdLine.GitAnnex.Options
+import qualified Utility.RawFilePath as R
 
 import qualified Utility.ShellEscape
-import qualified Utility.RawFilePath as R
 import qualified Annex
 import qualified Git.Filename
 import qualified Git.Types
@@ -1498,7 +1498,7 @@ test_nonannexed_symlink_conflict_resolution = do
 					git_annex "sync" [] "sync in r1"
 				indir r2 $ do
 					disconnectOrigin
-					createSymbolicLink symlinktarget "conflictor"
+					R.createSymbolicLink (toRawFilePath symlinktarget) (toRawFilePath "conflictor")
 					git "add" [conflictor] "git add conflictor"
 					git_annex "sync" [] "sync in r2"
 				pair r1 r2
@@ -1518,8 +1518,8 @@ test_nonannexed_symlink_conflict_resolution = do
 		length v == 1
 			@? (what ++ " too many variant files in: " ++ show v)
 		conflictor `elem` l @? (what ++ " conflictor file missing in: " ++ show l)
-		s <- catchMaybeIO (readSymbolicLink (d </> conflictor))
-		s == Just symlinktarget
+		s <- catchMaybeIO (R.readSymbolicLink (toRawFilePath (d </> conflictor)))
+		s == Just (toRawFilePath symlinktarget)
 			@? (what ++ " wrong target for nonannexed symlink: " ++ show s)
 
 {- Check merge conflict resolution when there is a local file,

Test/Framework.hs

@@ -25,10 +25,12 @@ import System.Console.Concurrent
 import System.Console.ANSI
 import GHC.Conc
 import System.IO.Unsafe (unsafePerformIO)
+import System.PosixCompat.Files (isSymbolicLink, isRegularFile, fileMode, unionFileModes, ownerWriteMode)
 
 import Common
 import Types.Test
 import Types.Concurrency
+import qualified Utility.RawFilePath as R
 
 import qualified Annex
 import qualified Annex.UUID
@@ -351,24 +353,24 @@ checklink f = ifM (annexeval Config.crippledFileSystem)
 	( (isJust <$> annexeval (Annex.Link.getAnnexLinkTarget (toRawFilePath f)))
 		@? f ++ " is not a (crippled) symlink"
 	, do
-		s <- getSymbolicLinkStatus f
+		s <- R.getSymbolicLinkStatus (toRawFilePath f)
 		isSymbolicLink s @? f ++ " is not a symlink"
 	)
 
 checkregularfile :: FilePath -> Assertion
 checkregularfile f = do
-	s <- getSymbolicLinkStatus f
+	s <- R.getSymbolicLinkStatus (toRawFilePath f)
 	isRegularFile s @? f ++ " is not a normal file"
 	return ()
 
 checkdoesnotexist :: FilePath -> Assertion
 checkdoesnotexist f = 
-	(either (const True) (const False) <$> Utility.Exception.tryIO (getSymbolicLinkStatus f))
+	(either (const True) (const False) <$> Utility.Exception.tryIO (R.getSymbolicLinkStatus (toRawFilePath f)))
 		@? f ++ " exists unexpectedly"
 
 checkexists :: FilePath -> Assertion
 checkexists f = 
-	(either (const False) (const True) <$> Utility.Exception.tryIO (getSymbolicLinkStatus f))
+	(either (const False) (const True) <$> Utility.Exception.tryIO (R.getSymbolicLinkStatus (toRawFilePath f)))
 		@? f ++ " does not exist"
 
 checkcontent :: FilePath -> Assertion
@@ -381,14 +383,14 @@ checkunwritable f = do
 	-- Look at permissions bits rather than trying to write or
 	-- using fileAccess because if run as root, any file can be
 	-- modified despite permissions.
-	s <- getFileStatus f
+	s <- R.getFileStatus (toRawFilePath f)
 	let mode = fileMode s
 	when (mode == mode `unionFileModes` ownerWriteMode) $
 		assertFailure $ "able to modify annexed file's " ++ f ++ " content"
 
 checkwritable :: FilePath -> Assertion
 checkwritable f = do
-	s <- getFileStatus f
+	s <- R.getFileStatus (toRawFilePath f)
 	let mode = fileMode s
 	unless (mode == mode `unionFileModes` ownerWriteMode) $
 		assertFailure $ "unable to modify " ++ f

Upgrade/V0.hs

@@ -11,6 +11,9 @@ import Annex.Common
 import Types.Upgrade
 import Annex.Content
 import qualified Upgrade.V1
+import qualified Utility.RawFilePath as R
+
+import System.PosixCompat.Files (isRegularFile)
 
 upgrade :: Annex UpgradeResult
 upgrade = do
@@ -46,7 +49,8 @@ getKeysPresent0 dir = ifM (liftIO $ doesDirectoryExist dir)
   where
 	present d = do
 		result <- tryIO $
-			getFileStatus $ dir ++ "/" ++ takeFileName d
+			R.getFileStatus $ toRawFilePath $
+				dir ++ "/" ++ takeFileName d
 		case result of
 			Right s -> return $ isRegularFile s
 			Left _ -> return False

Upgrade/V1.hs

@@ -15,6 +15,7 @@ import qualified Data.ByteString as S
 import qualified Data.ByteString.Short as S (toShort, fromShort)
 import qualified Data.ByteString.Lazy as L
 import qualified System.FilePath.ByteString as P
+import System.PosixCompat.Files (isRegularFile)
 
 import Annex.Common
 import Types.Upgrade
@@ -30,6 +31,7 @@ import Backend
 import Utility.FileMode
 import Utility.Tmp
 import qualified Upgrade.V2
+import qualified Utility.RawFilePath as R
 
 -- v2 adds hashing of filenames of content and location log files.
 -- Key information is encoded in filenames differently, so
@@ -101,7 +103,7 @@ updateSymlinks = do
 				link <- fromRawFilePath
 					<$> calcRepo (gitAnnexLink (toRawFilePath f) k)
 				liftIO $ removeFile f
-				liftIO $ createSymbolicLink link f
+				liftIO $ R.createSymbolicLink (toRawFilePath link) (toRawFilePath f)
 				Annex.Queue.addCommand [] "add" [Param "--"] [f]
 
 moveLocationLogs :: Annex ()
@@ -203,7 +205,8 @@ lookupKey1 file = do
 		Left _ -> return Nothing
 		Right l -> makekey l
   where
-	getsymlink = takeFileName <$> readSymbolicLink file
+	getsymlink = takeFileName . fromRawFilePath
+		<$> R.readSymbolicLink (toRawFilePath file)
 	makekey l = maybeLookupBackendVariety (fromKey keyVariety k) >>= \case
 		Nothing -> do
 			unless (null kname || null bname ||
@@ -232,7 +235,7 @@ getKeyFilesPresent1' dir =
 		)
   where
 	present f = do
-		result <- tryIO $ getFileStatus f
+		result <- tryIO $ R.getFileStatus (toRawFilePath f)
 		case result of
 			Right s -> return $ isRegularFile s
 			Left _ -> return False

Upgrade/V7.hs

@@ -24,6 +24,7 @@ import Config
 import qualified Utility.RawFilePath as R
 
 import qualified System.FilePath.ByteString as P
+import System.PosixCompat.Files (isSymbolicLink)
 
 upgrade :: Bool -> Annex UpgradeResult
 upgrade automatic = do
@@ -110,7 +111,7 @@ populateKeysDb = unlessM isBareRepo $ do
 	(l, cleanup) <- inRepo $ LsFiles.inodeCaches [top]
 	forM_ l $ \case
 		(_f, Nothing) -> giveup "Unable to parse git ls-files --debug output while upgrading git-annex sqlite databases."
-		(f, Just ic) -> unlessM (liftIO $ catchBoolIO $ isSymbolicLink <$> getSymbolicLinkStatus f) $ do
+		(f, Just ic) -> unlessM (liftIO $ catchBoolIO $ isSymbolicLink <$> R.getSymbolicLinkStatus (toRawFilePath f)) $ do
 			catKeyFile (toRawFilePath f) >>= \case
 				Nothing -> noop
 				Just k -> do

Utility/DirWatcher/INotify.hs

@@ -7,9 +7,10 @@
 
 module Utility.DirWatcher.INotify (watchDir) where
 
-import Common hiding (isDirectory)
+import Common
 import Utility.ThreadLock
 import Utility.DirWatcher.Types
+import qualified Utility.RawFilePath as R
 
 import System.INotify
 import qualified System.Posix.Files as Files
@@ -149,14 +150,14 @@ watchDir i dir ignored scanevents hooks
 
 	indir f = dir </> f
 
-	getstatus f = catchMaybeIO $ getSymbolicLinkStatus $ indir f
+	getstatus f = catchMaybeIO $ R.getSymbolicLinkStatus $ toRawFilePath $ indir f
 	checkfiletype check h f = do
 		ms <- getstatus f
 		case ms of
 			Just s
 				| check s -> runhook h f ms
 			_ -> noop
-	filetype t f = catchBoolIO $ t <$> getSymbolicLinkStatus (indir f)
+	filetype t f = catchBoolIO $ t <$> R.getSymbolicLinkStatus (toRawFilePath (indir f))
 
 	failedaddwatch e
 		-- Inotify fails when there are too many watches with a

Utility/DirWatcher/Win32Notify.hs

@@ -11,7 +11,7 @@ import Common hiding (isDirectory)
 import Utility.DirWatcher.Types
 
 import System.Win32.Notify
-import qualified System.PosixCompat.Files as Files
+import qualified System.PosixCompat.Files (isRegularFile)
 
 watchDir :: FilePath -> (FilePath -> Bool) -> Bool -> WatchHooks -> IO WatchManager
 watchDir dir ignored scanevents hooks = do
@@ -51,7 +51,7 @@ watchDir dir ignored scanevents hooks = do
 				case ms of
 					Nothing -> noop
 					Just s
-						| Files.isRegularFile s ->
+						| isRegularFile s ->
 							when scanevents $
 								runhook addHook ms
 						| otherwise ->

Utility/Directory.hs

@@ -16,7 +16,7 @@ module Utility.Directory (
 
 import Control.Monad
 import System.FilePath
-import System.PosixCompat.Files (getSymbolicLinkStatus, isDirectory, isSymbolicLink)
+import System.PosixCompat.Files (isDirectory, isSymbolicLink)
 import Control.Applicative
 import System.IO.Unsafe (unsafeInterleaveIO)
 import Data.Maybe
@@ -25,7 +25,8 @@ import Prelude
 import Utility.SystemDirectory
 import Utility.Exception
 import Utility.Monad
-import Utility.Applicative
+import Utility.FileSystemEncoding
+import qualified Utility.RawFilePath as R
 
 dirCruft :: FilePath -> Bool
 dirCruft "." = True
@@ -65,7 +66,7 @@ dirContentsRecursiveSkipping skipdir followsubdirsymlinks topdir = go [topdir]
 		| otherwise = do
 			let skip = collect (entry:files) dirs' entries
 			let recurse = collect files (entry:dirs') entries
-			ms <- catchMaybeIO $ getSymbolicLinkStatus entry
+			ms <- catchMaybeIO $ R.getSymbolicLinkStatus (toRawFilePath entry)
 			case ms of
 				(Just s) 
 					| isDirectory s -> recurse
@@ -87,9 +88,10 @@ dirTreeRecursiveSkipping skipdir topdir = go [] [topdir]
 		| skipdir (takeFileName dir) = go c dirs
 		| otherwise = unsafeInterleaveIO $ do
 			subdirs <- go []
-				=<< filterM (isDirectory <$$> getSymbolicLinkStatus)
+				=<< filterM isdir
 				=<< catchDefaultIO [] (dirContents dir)
 			go (subdirs++dir:c) dirs
+	isdir p = isDirectory <$> R.getSymbolicLinkStatus (toRawFilePath p)
 
 {- Use with an action that removes something, which may or may not exist.
  -

Utility/InodeCache.hs

@@ -51,6 +51,7 @@ import Utility.QuickCheck
 import qualified Utility.RawFilePath as R
 
 import System.PosixCompat.Types
+import System.PosixCompat.Files (isRegularFile, fileID)
 import Data.Time.Clock.POSIX
 
 #ifdef mingw32_HOST_OS

Utility/QuickCheck.hs

@@ -6,6 +6,7 @@
  -}
 
 {-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
 module Utility.QuickCheck

Utility/RawFilePath.hs

@@ -5,9 +5,11 @@
  -
  - On Windows, filenames are in unicode, so RawFilePaths have to be
  - decoded. So this library will work, but less efficiently than using
- - FilePath would.
+ - FilePath would. However, this library also takes care to support long
+ - filenames on Windows, by either using other libraries that do, or by
+ - doing UNC-style conversion itself.
  -
- - Copyright 2019-2020 Joey Hess <id@joeyh.name>
+ - Copyright 2019-2023 Joey Hess <id@joeyh.name>
  -
  - License: BSD-2-clause
  -}
@@ -27,7 +29,10 @@ module Utility.RawFilePath (
 	getCurrentDirectory,
 	createDirectory,
 	setFileMode,
+	setOwnerAndGroup,
 	rename,
+	createNamedPipe,
+	fileAccess,
 ) where
 
 #ifndef mingw32_HOST_OS
@@ -48,23 +53,28 @@ createDirectory p = D.createDirectory p 0o777
 
 #else
 import System.PosixCompat (FileStatus, FileMode)
+-- System.PosixCompat does not handle UNC-style conversion itself,
+-- so all uses of it library have to be pre-converted below. See
+-- https://github.com/jacobstanley/unix-compat/issues/56
 import qualified System.PosixCompat as P
-import qualified System.PosixCompat.Files as F
 import qualified System.Directory as D
 import Utility.FileSystemEncoding
+import Utility.Path.Windows
 
 readSymbolicLink :: RawFilePath -> IO RawFilePath
 readSymbolicLink f = toRawFilePath <$> P.readSymbolicLink (fromRawFilePath f)
 
 createSymbolicLink :: RawFilePath -> RawFilePath -> IO ()
-createSymbolicLink a b = P.createSymbolicLink
-	(fromRawFilePath a)
-	(fromRawFilePath b)
+createSymbolicLink a b = do
+	a' <- fromRawFilePath <$> convertToWindowsNativeNamespace a
+	b' <- fromRawFilePath <$> convertToWindowsNativeNamespace b
+	P.createSymbolicLink a' b'
 
 createLink :: RawFilePath -> RawFilePath -> IO ()
-createLink a b = P.createLink
-	(fromRawFilePath a)
-	(fromRawFilePath b)
+createLink a b = do
+	a' <- fromRawFilePath <$> convertToWindowsNativeNamespace a
+	b' <- fromRawFilePath <$> convertToWindowsNativeNamespace b
+	P.createLink a' b'
 
 {- On windows, removeLink is not available, so only remove files,
  - not symbolic links. -}
@@ -72,10 +82,12 @@ removeLink :: RawFilePath -> IO ()
 removeLink = D.removeFile . fromRawFilePath
 
 getFileStatus :: RawFilePath -> IO FileStatus
-getFileStatus = P.getFileStatus . fromRawFilePath
+getFileStatus p = P.getFileStatus . fromRawFilePath
+	=<< convertToWindowsNativeNamespace p
 
 getSymbolicLinkStatus :: RawFilePath -> IO FileStatus
-getSymbolicLinkStatus = P.getSymbolicLinkStatus . fromRawFilePath
+getSymbolicLinkStatus p = P.getSymbolicLinkStatus . fromRawFilePath
+	=<< convertToWindowsNativeNamespace p
 
 doesPathExist :: RawFilePath -> IO Bool
 doesPathExist = D.doesPathExist . fromRawFilePath
@@ -87,10 +99,27 @@ createDirectory :: RawFilePath -> IO ()
 createDirectory = D.createDirectory . fromRawFilePath
 
 setFileMode :: RawFilePath -> FileMode -> IO () 
-setFileMode = F.setFileMode . fromRawFilePath
+setFileMode p m = do
+	p' <- fromRawFilePath <$> convertToWindowsNativeNamespace p
+	P.setFileMode p' m
 
 {- Using renamePath rather than the rename provided in unix-compat
  - because of this bug https://github.com/jacobstanley/unix-compat/issues/56-}
 rename :: RawFilePath -> RawFilePath -> IO ()
 rename a b = D.renamePath (fromRawFilePath a) (fromRawFilePath b)
+
+setOwnerAndGroup :: RawFilePath -> P.UserID -> P.GroupID -> IO ()
+setOwnerAndGroup p u g = do
+	p' <- fromRawFilePath <$> convertToWindowsNativeNamespace p
+	P.setOwnerAndGroup p' u g
+
+createNamedPipe :: RawFilePath -> FileMode -> IO ()
+createNamedPipe p m = do
+	p' <- fromRawFilePath <$> convertToWindowsNativeNamespace p
+	P.createNamedPipe p' m
+
+fileAccess :: RawFilePath -> Bool -> Bool -> Bool -> IO Bool
+fileAccess p a b c = do
+	p' <- fromRawFilePath <$> convertToWindowsNativeNamespace p
+	P.fileAccess p' a b c
 #endif

Utility/SshConfig.hs

@@ -32,6 +32,7 @@ import Utility.FileMode
 import Data.Char
 import Data.Ord
 import Data.Either
+import System.PosixCompat.Files (groupWriteMode, otherWriteMode)
 
 data SshConfig
 	= GlobalConfig SshSetting

Utility/Tmp.hs

@@ -21,12 +21,12 @@ import System.IO
 import System.FilePath
 import System.Directory
 import Control.Monad.IO.Class
-import System.PosixCompat.Files hiding (removeLink)
 import System.IO.Error
 
 import Utility.Exception
 import Utility.FileSystemEncoding
 import Utility.FileMode
+import qualified Utility.RawFilePath as R
 
 type Template = String
 
@@ -62,14 +62,15 @@ viaTmp a file content = bracketIO setup cleanup use
 		_ <- tryIO $ hClose h
 		tryIO $ removeFile tmpfile
 	use (tmpfile, h) = do
+		let tmpfile' = toRawFilePath tmpfile
 		-- Make mode the same as if the file were created usually,
 		-- not as a temp file. (This may fail on some filesystems
 		-- that don't support file modes well, so ignore
 		-- exceptions.)
-		_ <- liftIO $ tryIO $ setFileMode tmpfile =<< defaultFileMode
+		_ <- liftIO $ tryIO $ R.setFileMode tmpfile' =<< defaultFileMode
 		liftIO $ hClose h
 		a tmpfile content
-		liftIO $ rename tmpfile file
+		liftIO $ R.rename tmpfile' (toRawFilePath file)
 
 {- Runs an action with a tmp file located in the system's tmp directory
  - (or in "." if there is none) then removes the file. -}

Utility/Tor.hs

@@ -22,8 +22,10 @@ module Utility.Tor (
 import Common
 import Utility.ThreadScheduler
 import Utility.FileMode
+import Utility.RawFilePath (setOwnerAndGroup)
 
 import System.PosixCompat.Types
+import System.PosixCompat.Files (ownerReadMode, ownerWriteMode, ownerExecuteMode)
 import Data.Char
 import Network.Socket
 import Network.Socks5
@@ -165,7 +167,7 @@ getHiddenServiceSocketFile _appname uid ident =
 prepHiddenServiceSocketDir :: AppName -> UserID -> UniqueIdent -> IO ()
 prepHiddenServiceSocketDir appname uid ident = do
 	createDirectoryIfMissing True d
-	setOwnerAndGroup d uid (-1)
+	setOwnerAndGroup (toRawFilePath d) uid (-1)
 	modifyFileMode (toRawFilePath d) $
 		addModes [ownerReadMode, ownerExecuteMode, ownerWriteMode]
   where