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

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