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
This commit is contained in:
Joey Hess 2023-03-01 15:55:58 -04:00
parent 505f1a654b
commit 54ad1b4cfb
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
57 changed files with 185 additions and 84 deletions

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

@ -44,6 +44,8 @@ import Config
import Utility.Directory.Create import Utility.Directory.Create
import qualified Utility.RawFilePath as R 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 :: (SharedRepository -> Annex a) -> Annex a
withShared a = a =<< coreSharedRepository <$> Annex.getGitConfig withShared a = a =<< coreSharedRepository <$> Annex.getGitConfig

View file

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

View file

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

View file

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

View file

@ -53,6 +53,7 @@ import Utility.DiskFree
import Data.Time.Clock.POSIX import Data.Time.Clock.POSIX
import qualified Data.Text as T 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 {- 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 - 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 (unstaged, cleanup) <- liftIO $ Git.LsFiles.notInRepo [] False ["."] g
now <- liftIO getPOSIXTime now <- liftIO getPOSIXTime
forM_ unstaged $ \file -> do forM_ unstaged $ \file -> do
let file' = fromRawFilePath file ms <- liftIO $ catchMaybeIO $ R.getSymbolicLinkStatus file
ms <- liftIO $ catchMaybeIO $ getSymbolicLinkStatus file'
case ms of case ms of
Just s | toonew (statusChangeTime s) now -> noop Just s | toonew (statusChangeTime s) now -> noop
| isSymbolicLink s -> addsymlink file' ms | isSymbolicLink s -> addsymlink (fromRawFilePath file) ms
_ -> noop _ -> noop
liftIO $ void cleanup liftIO $ void cleanup

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

@ -31,7 +31,7 @@ import Annex.CheckIgnore
import qualified Utility.RawFilePath as R import qualified Utility.RawFilePath as R
import qualified System.FilePath.ByteString as P 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 :: Command
cmd = notBareRepo $ cmd = notBareRepo $

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

@ -13,7 +13,7 @@ import Data.Default as X
import System.FilePath as X import System.FilePath as X
import System.IO as X hiding (FilePath) import System.IO as X hiding (FilePath)
import System.Exit as X 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.Misc as X
import Utility.Exception as X import Utility.Exception as X

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

@ -5,9 +5,11 @@
- -
- On Windows, filenames are in unicode, so RawFilePaths have to be - On Windows, filenames are in unicode, so RawFilePaths have to be
- decoded. So this library will work, but less efficiently than using - 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 - License: BSD-2-clause
-} -}
@ -27,7 +29,10 @@ module Utility.RawFilePath (
getCurrentDirectory, getCurrentDirectory,
createDirectory, createDirectory,
setFileMode, setFileMode,
setOwnerAndGroup,
rename, rename,
createNamedPipe,
fileAccess,
) where ) where
#ifndef mingw32_HOST_OS #ifndef mingw32_HOST_OS
@ -48,23 +53,28 @@ createDirectory p = D.createDirectory p 0o777
#else #else
import System.PosixCompat (FileStatus, FileMode) 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 as P
import qualified System.PosixCompat.Files as F
import qualified System.Directory as D import qualified System.Directory as D
import Utility.FileSystemEncoding import Utility.FileSystemEncoding
import Utility.Path.Windows
readSymbolicLink :: RawFilePath -> IO RawFilePath readSymbolicLink :: RawFilePath -> IO RawFilePath
readSymbolicLink f = toRawFilePath <$> P.readSymbolicLink (fromRawFilePath f) readSymbolicLink f = toRawFilePath <$> P.readSymbolicLink (fromRawFilePath f)
createSymbolicLink :: RawFilePath -> RawFilePath -> IO () createSymbolicLink :: RawFilePath -> RawFilePath -> IO ()
createSymbolicLink a b = P.createSymbolicLink createSymbolicLink a b = do
(fromRawFilePath a) a' <- fromRawFilePath <$> convertToWindowsNativeNamespace a
(fromRawFilePath b) b' <- fromRawFilePath <$> convertToWindowsNativeNamespace b
P.createSymbolicLink a' b'
createLink :: RawFilePath -> RawFilePath -> IO () createLink :: RawFilePath -> RawFilePath -> IO ()
createLink a b = P.createLink createLink a b = do
(fromRawFilePath a) a' <- fromRawFilePath <$> convertToWindowsNativeNamespace a
(fromRawFilePath b) b' <- fromRawFilePath <$> convertToWindowsNativeNamespace b
P.createLink a' b'
{- On windows, removeLink is not available, so only remove files, {- On windows, removeLink is not available, so only remove files,
- not symbolic links. -} - not symbolic links. -}
@ -72,10 +82,12 @@ removeLink :: RawFilePath -> IO ()
removeLink = D.removeFile . fromRawFilePath removeLink = D.removeFile . fromRawFilePath
getFileStatus :: RawFilePath -> IO FileStatus getFileStatus :: RawFilePath -> IO FileStatus
getFileStatus = P.getFileStatus . fromRawFilePath getFileStatus p = P.getFileStatus . fromRawFilePath
=<< convertToWindowsNativeNamespace p
getSymbolicLinkStatus :: RawFilePath -> IO FileStatus getSymbolicLinkStatus :: RawFilePath -> IO FileStatus
getSymbolicLinkStatus = P.getSymbolicLinkStatus . fromRawFilePath getSymbolicLinkStatus p = P.getSymbolicLinkStatus . fromRawFilePath
=<< convertToWindowsNativeNamespace p
doesPathExist :: RawFilePath -> IO Bool doesPathExist :: RawFilePath -> IO Bool
doesPathExist = D.doesPathExist . fromRawFilePath doesPathExist = D.doesPathExist . fromRawFilePath
@ -87,10 +99,27 @@ createDirectory :: RawFilePath -> IO ()
createDirectory = D.createDirectory . fromRawFilePath createDirectory = D.createDirectory . fromRawFilePath
setFileMode :: RawFilePath -> FileMode -> IO () 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 {- Using renamePath rather than the rename provided in unix-compat
- because of this bug https://github.com/jacobstanley/unix-compat/issues/56-} - because of this bug https://github.com/jacobstanley/unix-compat/issues/56-}
rename :: RawFilePath -> RawFilePath -> IO () rename :: RawFilePath -> RawFilePath -> IO ()
rename a b = D.renamePath (fromRawFilePath a) (fromRawFilePath b) 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 #endif

View file

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

View file

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

View file

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