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:
parent
505f1a654b
commit
54ad1b4cfb
57 changed files with 185 additions and 84 deletions
|
@ -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.
|
||||||
|
|
|
@ -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.
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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 ()
|
||||||
|
|
|
@ -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"
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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)
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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. -}
|
||||||
|
|
|
@ -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]
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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 $
|
||||||
|
|
|
@ -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 $
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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] $
|
||||||
|
|
|
@ -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))
|
||||||
|
|
|
@ -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 $
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -21,6 +21,8 @@ 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] $
|
||||||
command "lock" SectionCommon
|
command "lock" SectionCommon
|
||||||
|
|
|
@ -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"
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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"
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
3
Limit.hs
3
Limit.hs
|
@ -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
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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)))
|
||||||
|
|
|
@ -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"
|
||||||
|
|
8
Test.hs
8
Test.hs
|
@ -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,
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 ->
|
||||||
|
|
|
@ -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.
|
||||||
-
|
-
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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. -}
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue