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.
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.
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
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.
- 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)
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.
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
import Annex.FileMatcher
import qualified Utility.RawFilePath as R
+import System.PosixCompat.Files (fileMode)
+
data LockedDown = LockedDown
{ lockDownConfig :: LockDownConfig
, keySource :: KeySource
`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
}
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
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
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
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
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
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.
--
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 ()
import Utility.Android
#endif
+import System.PosixCompat.Files (ownerExecuteMode)
+
standaloneAppBase :: IO (Maybe FilePath)
standaloneAppBase = getEnv "GIT_ANNEX_APP_BASE"
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
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
- 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
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
(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
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
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)
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
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
( 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. -}
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]
import Utility.SafeCommand
import Utility.Env.Basic
import qualified Git.Version
-import Utility.Directory
+import Utility.SystemDirectory
import Control.Monad
import Control.Applicative
import Utility.FreeDesktop
import Utility.Path
import Utility.Monad
-import Utility.Directory
+import Utility.SystemDirectory
import Utility.FileSystemEncoding
import Config.Files
import Utility.OSX
import Utility.Path
import Utility.Monad
import Utility.SafeCommand
-import Utility.Directory
+import Utility.SystemDirectory
import System.IO
import System.FilePath
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
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
-- 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'))
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")
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 $
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 $
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
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] $
)
doesnotexist :: FilePath -> IO Bool
-doesnotexist f = isNothing <$> catchMaybeIO (getSymbolicLinkStatus f)
+doesnotexist f = isNothing <$> catchMaybeIO (R.getSymbolicLinkStatus (toRawFilePath f))
import qualified Utility.RawFilePath as R
import Control.Concurrent.STM
+import System.PosixCompat.Files (isDirectory, isSymbolicLink, isRegularFile)
cmd :: Command
cmd = notBareRepo $
import Annex.UntrustedFilePath
import qualified Annex.Branch
import Logs
+import qualified Utility.RawFilePath as R
cmd :: Command
cmd = notBareRepo $ withAnnexOptions [backendOption] $
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
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
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))
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
(_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
import Logs.Location
import Git.FilePath
import qualified Utility.RawFilePath as R
+
+import System.PosixCompat.Files (linkCount)
cmd :: Command
cmd = withAnnexOptions [jsonOptions, annexedMatchingOptions] $
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"
import Git.FilePath
import qualified Utility.RawFilePath as R
+import System.PosixCompat.Files (linkCount)
+
cmd :: Command
cmd = withAnnexOptions [annexedMatchingOptions] $
command "unannex" SectionUtility
import Utility.FileMode
import qualified Utility.RawFilePath as R
+import System.PosixCompat.Files (linkCount)
+
cmd :: Command
cmd = addCheck check $
command "uninit" SectionUtility
import qualified Database.Keys
import qualified Utility.RawFilePath as R
+import System.PosixCompat.Files (fileMode)
+
cmd :: Command
cmd = mkcmd "unlock" "unlock files for modification"
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
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
let f = hookFile h r
catchBoolIO $
#ifndef mingw32_HOST_OS
- isExecutable . fileMode <$> getFileStatus f
+ isExecutable . fileMode <$> R.getFileStatus (toRawFilePath f)
#else
doesFileExist f
#endif
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. -}
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
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.
--
-- 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)
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)
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
import Annex.UUID
import Utility.SshHost
import Types.ProposedAccepted
+import qualified Utility.RawFilePath as R
data DdarRepo = DdarRepo
{ ddarRepoConfig :: RemoteGitConfig
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
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
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
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
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)))
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
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"
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
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
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,
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
( (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
-- 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
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
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
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
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
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 ()
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 ||
)
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
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
(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
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
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
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
case ms of
Nothing -> noop
Just s
- | Files.isRegularFile s ->
+ | isRegularFile s ->
when scanevents $
runhook addHook ms
| otherwise ->
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
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
| 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
| 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.
-
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
-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
{-# LANGUAGE TypeSynonymInstances #-}
module Utility.QuickCheck
-
- 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
-}
getCurrentDirectory,
createDirectory,
setFileMode,
+ setOwnerAndGroup,
rename,
+ createNamedPipe,
+ fileAccess,
) where
#ifndef mingw32_HOST_OS
#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. -}
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
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
import Data.Char
import Data.Ord
import Data.Either
+import System.PosixCompat.Files (groupWriteMode, otherWriteMode)
data SshConfig
= GlobalConfig SshSetting
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
_ <- 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. -}
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
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
projects / git-annex.git / commitdiff