avoid unix-compat's rename
On Windows, that does not support long paths https://github.com/jacobstanley/unix-compat/issues/56 Instead, use System.Directory.renamePath, which does support long paths. Sponsored-by: Dartmouth College's Datalad project
This commit is contained in:
parent
bad39cadc6
commit
2d65c4ff1d
18 changed files with 75 additions and 20 deletions
|
@ -207,13 +207,13 @@ upgradeToDistribution newdir cleanup distributionfile = do
|
|||
unless tarok $
|
||||
error $ "failed to untar " ++ distributionfile
|
||||
sanitycheck $ tmpdir </> installBase
|
||||
installby rename newdir (tmpdir </> installBase)
|
||||
installby R.rename newdir (tmpdir </> installBase)
|
||||
let deleteold = do
|
||||
deleteFromManifest olddir
|
||||
makeorigsymlink olddir
|
||||
return (newdir </> "git-annex", deleteold)
|
||||
installby a dstdir srcdir =
|
||||
mapM_ (\x -> a x (dstdir </> takeFileName x))
|
||||
mapM_ (\x -> a (toRawFilePath x) (toRawFilePath (dstdir </> takeFileName x)))
|
||||
=<< dirContents srcdir
|
||||
#endif
|
||||
sanitycheck dir =
|
||||
|
|
|
@ -30,7 +30,7 @@ import Annex.CheckIgnore
|
|||
import qualified Utility.RawFilePath as R
|
||||
import qualified System.FilePath.ByteString as P
|
||||
|
||||
import System.PosixCompat.Files
|
||||
import System.PosixCompat.Files (fileSize)
|
||||
|
||||
cmd :: Command
|
||||
cmd = notBareRepo $
|
||||
|
|
|
@ -181,11 +181,11 @@ runFuzzAction (FuzzAdd (FuzzFile f)) = do
|
|||
runFuzzAction (FuzzDelete (FuzzFile f)) = liftIO $
|
||||
removeWhenExistsWith R.removeLink (toRawFilePath f)
|
||||
runFuzzAction (FuzzMove (FuzzFile src) (FuzzFile dest)) = liftIO $
|
||||
rename src dest
|
||||
R.rename (toRawFilePath src) (toRawFilePath dest)
|
||||
runFuzzAction (FuzzDeleteDir (FuzzDir d)) = liftIO $
|
||||
removeDirectoryRecursive d
|
||||
runFuzzAction (FuzzMoveDir (FuzzDir src) (FuzzDir dest)) = liftIO $
|
||||
rename src dest
|
||||
R.rename (toRawFilePath src) (toRawFilePath dest)
|
||||
runFuzzAction (FuzzPause d) = randomDelay d
|
||||
|
||||
genFuzzAction :: Annex FuzzAction
|
||||
|
|
|
@ -216,7 +216,7 @@ storeReceived f = do
|
|||
Just k -> void $ logStatusAfter k $
|
||||
getViaTmpFromDisk RetrievalVerifiableKeysSecure AlwaysVerify k (AssociatedFile Nothing) $ \dest -> unVerified $
|
||||
liftIO $ catchBoolIO $ do
|
||||
rename f (fromRawFilePath dest)
|
||||
R.rename (toRawFilePath f) dest
|
||||
return True
|
||||
|
||||
-- Under Windows, uftp uses key containers, which are not files on the
|
||||
|
|
|
@ -13,7 +13,7 @@ import Data.Default as X
|
|||
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)
|
||||
import System.PosixCompat.Files as X hiding (fileSize, removeLink, rename)
|
||||
|
||||
import Utility.Misc as X
|
||||
import Utility.Exception as X
|
||||
|
|
|
@ -45,7 +45,7 @@ initDb db migration = do
|
|||
setAnnexFilePerm tmpdb
|
||||
liftIO $ do
|
||||
void $ tryIO $ removeDirectoryRecursive (fromRawFilePath dbdir)
|
||||
rename (fromRawFilePath tmpdbdir) (fromRawFilePath dbdir)
|
||||
R.rename tmpdbdir dbdir
|
||||
|
||||
{- Make sure that the database uses WAL mode, to prevent readers
|
||||
- from blocking writers, and prevent a writer from blocking readers.
|
||||
|
|
|
@ -514,11 +514,11 @@ storeExportWithContentIdentifierM ii dir cow src _k loc overwritablecids p = do
|
|||
checkExportContent ii dir loc
|
||||
overwritablecids
|
||||
(giveup "unsafe to overwrite file")
|
||||
(const $ liftIO $ rename tmpf dest)
|
||||
(const $ liftIO $ R.rename tmpf' dest)
|
||||
return newcid
|
||||
where
|
||||
dest = fromRawFilePath $ exportPath dir loc
|
||||
(destdir, base) = splitFileName dest
|
||||
dest = exportPath dir loc
|
||||
(destdir, base) = splitFileName (fromRawFilePath dest)
|
||||
template = relatedTemplate (base ++ ".tmp")
|
||||
|
||||
removeExportWithContentIdentifierM :: IgnoreInodes -> RawFilePath -> Key -> ExportLocation -> [ContentIdentifier] -> Annex ()
|
||||
|
|
|
@ -47,6 +47,7 @@ import Utility.Tmp.Dir
|
|||
import Utility.SshHost
|
||||
import Annex.SpecialRemote.Config
|
||||
import Annex.Verify
|
||||
import qualified Utility.RawFilePath as R
|
||||
|
||||
import qualified Data.Map as M
|
||||
|
||||
|
@ -224,7 +225,7 @@ store o k src meterupdate = storeGeneric o meterupdate basedest populatedest
|
|||
basedest = fromRawFilePath $ Prelude.head (keyPaths k)
|
||||
populatedest dest = liftIO $ if canrename
|
||||
then do
|
||||
rename src dest
|
||||
R.rename (toRawFilePath src) (toRawFilePath dest)
|
||||
return True
|
||||
else createLinkOrCopy (toRawFilePath src) (toRawFilePath dest)
|
||||
{- If the key being sent is encrypted or chunked, the file
|
||||
|
|
|
@ -16,7 +16,7 @@ module Utility.Directory (
|
|||
|
||||
import Control.Monad
|
||||
import System.FilePath
|
||||
import System.PosixCompat.Files hiding (removeLink)
|
||||
import System.PosixCompat.Files (getSymbolicLinkStatus, isDirectory, isSymbolicLink)
|
||||
import Control.Applicative
|
||||
import System.IO.Unsafe (unsafeInterleaveIO)
|
||||
import Data.Maybe
|
||||
|
|
|
@ -16,7 +16,7 @@ module Utility.FileMode (
|
|||
import System.IO
|
||||
import Control.Monad
|
||||
import System.PosixCompat.Types
|
||||
import System.PosixCompat.Files hiding (removeLink)
|
||||
import System.PosixCompat.Files (unionFileModes, intersectFileModes, stdFileMode, nullFileMode, setFileCreationMask, groupReadMode, ownerReadMode, ownerWriteMode, ownerExecuteMode, groupWriteMode, groupExecuteMode, otherReadMode, otherWriteMode, otherExecuteMode, fileMode)
|
||||
import Control.Monad.IO.Class
|
||||
import Foreign (complement)
|
||||
import Control.Monad.Catch
|
||||
|
|
|
@ -14,7 +14,7 @@ module Utility.FileSize (
|
|||
getFileSize',
|
||||
) where
|
||||
|
||||
import System.PosixCompat.Files hiding (removeLink)
|
||||
import System.PosixCompat.Files (FileStatus, fileSize)
|
||||
import qualified Utility.RawFilePath as R
|
||||
#ifdef mingw32_HOST_OS
|
||||
import Control.Exception (bracket)
|
||||
|
|
|
@ -18,6 +18,7 @@ module Utility.LogFile (
|
|||
) where
|
||||
|
||||
import Common
|
||||
import Utility.RawFilePath
|
||||
|
||||
#ifndef mingw32_HOST_OS
|
||||
import System.Posix.Types
|
||||
|
@ -36,7 +37,7 @@ rotateLog logfile = go 0
|
|||
| num > maxLogs = return ()
|
||||
| otherwise = whenM (doesFileExist currfile) $ do
|
||||
go (num + 1)
|
||||
rename currfile nextfile
|
||||
rename (toRawFilePath currfile) (toRawFilePath nextfile)
|
||||
where
|
||||
currfile = filename num
|
||||
nextfile = filename (num + 1)
|
||||
|
|
|
@ -89,6 +89,8 @@ createDirectory = D.createDirectory . fromRawFilePath
|
|||
setFileMode :: RawFilePath -> FileMode -> IO ()
|
||||
setFileMode = F.setFileMode . fromRawFilePath
|
||||
|
||||
{- 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 = F.rename (fromRawFilePath a) (fromRawFilePath b)
|
||||
rename a b = D.renamePath (fromRawFilePath a) (fromRawFilePath b)
|
||||
#endif
|
||||
|
|
|
@ -21,7 +21,7 @@ import Utility.Data
|
|||
import Control.Applicative
|
||||
#endif
|
||||
|
||||
import System.PosixCompat
|
||||
import System.PosixCompat.User
|
||||
import Prelude
|
||||
|
||||
{- Current user's home directory.
|
||||
|
|
|
@ -33,3 +33,5 @@ CI used
|
|||
### Have you had any luck using git-annex before? (Sometimes we get tired of reading bug reports all day and a lil' positive end note does wonders)
|
||||
|
||||
All the time! Sorry to mostly show up when there is an issue!
|
||||
|
||||
[[!tag projects/datalad]]
|
||||
|
|
|
@ -0,0 +1,24 @@
|
|||
[[!comment format=mdwn
|
||||
username="joey"
|
||||
subject="""comment 2"""
|
||||
date="2022-07-12T16:50:16Z"
|
||||
content="""
|
||||
Actually testremote will not accept --backend in current master, since that
|
||||
is no longer a global option and is accepted only by commands that can
|
||||
actually use it.
|
||||
|
||||
testremote cannot support an arbitrary backend here, because it needs to
|
||||
generate a test key that cannot possibly be used for real data. The only
|
||||
backend that has a way implemented to do that is SHA256. It would not,
|
||||
for example, be possible to make the WORM backend support that, since every
|
||||
possible WORM key could be used by real data.
|
||||
|
||||
It would be possible to add support for --backend=MD5 and have it reject
|
||||
other backends. But this does not strike me as solving the real problem.
|
||||
|
||||
Also, in [[bugs/tests_fail_on_windows__58___retrieveKeyFile_resume]]
|
||||
I ran into this same problem, when `git-annex test` was ran, and
|
||||
worked around it by disabling that part of the test suite on windows.
|
||||
If this is fixed, it would be worth re-enabling that, although it may have
|
||||
also been failing for other reasons on windows.
|
||||
"""]]
|
|
@ -0,0 +1,24 @@
|
|||
[[!comment format=mdwn
|
||||
username="joey"
|
||||
subject="""comment 3"""
|
||||
date="2022-07-12T17:42:51Z"
|
||||
content="""
|
||||
ghc's IO manager tries to support Windows long paths by normalizing to
|
||||
an UNC-style path in many system calls. However, when git-annex calls
|
||||
rename, on windows that ends up in Win32's moveFileEx (via unix-compat),
|
||||
and that does not do UNC-style normalization. And given the description of
|
||||
the Win32 package, I think it's intended to pass data directly through
|
||||
to the API without anything fancy.
|
||||
|
||||
System.Directory.renamePath could be used instead of Win32.
|
||||
While it still uses Win32 moveFileEx, it first does an UNC-style
|
||||
normalization. Filed an issue:
|
||||
<https://github.com/jacobstanley/unix-compat/issues/56>
|
||||
|
||||
Rather than waiting for that to be fixed, I've made git-annex
|
||||
use System.Directory.renamePath instead itself. But I don't know
|
||||
if it will be enough to make testremote work, or if it will fall over
|
||||
on a later operation on the same too-long path.
|
||||
getFileStatus/getSymbolicLinkStatus seem like the main things in
|
||||
unix-compat that would still be a problem.
|
||||
"""]]
|
|
@ -294,10 +294,11 @@ source-repository head
|
|||
|
||||
custom-setup
|
||||
Setup-Depends: base (>= 4.11.1.0), split, unix-compat,
|
||||
filepath, exceptions, bytestring, directory, IfElse, data-default,
|
||||
filepath, exceptions, bytestring, IfElse, data-default,
|
||||
filepath-bytestring (>= 1.4.2.1.4),
|
||||
process (>= 1.6.3),
|
||||
time (>= 1.5.0),
|
||||
directory (>= 1.2.7.0),
|
||||
async, utf8-string, transformers, Cabal
|
||||
|
||||
Executable git-annex
|
||||
|
@ -319,7 +320,7 @@ Executable git-annex
|
|||
unix-compat (>= 0.5),
|
||||
SafeSemaphore,
|
||||
async,
|
||||
directory (>= 1.2),
|
||||
directory (>= 1.2.7.0),
|
||||
disk-free-space,
|
||||
filepath,
|
||||
filepath-bytestring (>= 1.4.2.1.1),
|
||||
|
|
Loading…
Reference in a new issue