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

Works around this bug in unix-compat:
jacobstanley/unix-compat#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 <[email protected]>  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 $