diff --git a/Annex/AdjustedBranch/Merge.hs b/Annex/AdjustedBranch/Merge.hs index c2cce8754d..79f86c2884 100644 --- a/Annex/AdjustedBranch/Merge.hs +++ b/Annex/AdjustedBranch/Merge.hs @@ -82,15 +82,14 @@ mergeToAdjustedBranch tomerge (origbranch, adj) mergeconfig canresolvemerge comm refs <- liftIO $ dirContentsRecursive $ git_dir' "refs" let refs' = (git_dir' "packed-refs") : refs - liftIO $ forM_ refs' $ \src -> + liftIO $ forM_ refs' $ \src -> do + let src' = toRawFilePath src whenM (doesFileExist src) $ do - dest <- relPathDirToFile git_dir - (toRawFilePath src) + dest <- relPathDirToFile git_dir src' let dest' = toRawFilePath tmpgit P. dest createDirectoryUnder git_dir (P.takeDirectory dest') - void $ createLinkOrCopy src - (fromRawFilePath dest') + void $ createLinkOrCopy src' dest' -- This reset makes git merge not care -- that the work tree is empty; otherwise -- it will think that all the files have diff --git a/Annex/Content.hs b/Annex/Content.hs index 754127bd55..e0dc1a7841 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -410,9 +410,7 @@ moveAnnex key af src = ifM (checkSecureHashes' key) storeobject dest = ifM (liftIO $ R.doesPathExist dest) ( alreadyhave , adjustedBranchRefresh af $ modifyContentDir dest $ do - liftIO $ moveFile - (fromRawFilePath src) - (fromRawFilePath dest) + liftIO $ moveFile src dest -- Freeze the object file now that it is in place. -- Waiting until now to freeze it allows for freeze -- hooks that prevent moving the file. @@ -654,17 +652,16 @@ removeAnnex (ContentRemovalLock key) = withObjectLoc key $ \file -> {- Moves a key out of .git/annex/objects/ into .git/annex/bad, and - returns the file it was moved to. -} -moveBad :: Key -> Annex FilePath +moveBad :: Key -> Annex RawFilePath moveBad key = do src <- calcRepo (gitAnnexLocation key) bad <- fromRepo gitAnnexBadDir let dest = bad P. P.takeFileName src - let dest' = fromRawFilePath dest createAnnexDirectory (parentDir dest) cleanObjectLoc key $ - liftIO $ moveFile (fromRawFilePath src) dest' + liftIO $ moveFile src dest logStatus key InfoMissing - return dest' + return dest data KeyLocation = InAnnex | InAnywhere diff --git a/Annex/Journal.hs b/Annex/Journal.hs index 0d6056b9ba..de0ad77655 100644 --- a/Annex/Journal.hs +++ b/Annex/Journal.hs @@ -84,10 +84,11 @@ setJournalFile _jl ru file content = withOtherTmp $ \tmp -> do createAnnexDirectory jd -- journal file is written atomically let jfile = journalFile file - let tmpfile = fromRawFilePath (tmp P. jfile) + let tmpfile = tmp P. jfile liftIO $ do - withFile tmpfile WriteMode $ \h -> writeJournalHandle h content - moveFile tmpfile (fromRawFilePath (jd P. jfile)) + withFile (fromRawFilePath tmpfile) WriteMode $ \h -> + writeJournalHandle h content + moveFile tmpfile (jd P. jfile) data JournalledContent = NoJournalledContent diff --git a/Annex/Link.hs b/Annex/Link.hs index edafe9029a..9cc39ab81d 100644 --- a/Annex/Link.hs +++ b/Annex/Link.hs @@ -218,10 +218,10 @@ restagePointerFile (Restage True) f orig = withTSDelta $ \tsd -> showwarning = warning $ unableToRestage Nothing go Nothing = showwarning go (Just _) = withTmpDirIn (fromRawFilePath $ Git.localGitDir r) "annexindex" $ \tmpdir -> do - let tmpindex = tmpdir "index" + let tmpindex = toRawFilePath (tmpdir "index") let updatetmpindex = do r' <- liftIO $ Git.Env.addGitEnv r Git.Index.indexEnv - =<< Git.Index.indexEnvVal (toRawFilePath tmpindex) + =<< Git.Index.indexEnvVal tmpindex -- Avoid git warning about CRLF munging. let r'' = r' { gitGlobalOpts = gitGlobalOpts r' ++ [ Param "-c" @@ -233,9 +233,9 @@ restagePointerFile (Restage True) f orig = withTSDelta $ \tsd -> whenM checkunmodified $ feed f' let replaceindex = catchBoolIO $ do - moveFile tmpindex (fromRawFilePath realindex) + moveFile tmpindex realindex return True - ok <- liftIO (createLinkOrCopy (fromRawFilePath realindex) tmpindex) + ok <- liftIO (createLinkOrCopy realindex tmpindex) <&&> updatetmpindex <&&> liftIO replaceindex unless ok showwarning diff --git a/Annex/ReplaceFile.hs b/Annex/ReplaceFile.hs index 04125fd7c3..21c6f29744 100644 --- a/Annex/ReplaceFile.hs +++ b/Annex/ReplaceFile.hs @@ -75,13 +75,13 @@ replaceFile' createdirectory file checkres action = withOtherTmp $ \othertmpdir let tmpfile = tmpdir basetmp r <- action tmpfile when (checkres r) $ - replaceFileFrom tmpfile file createdirectory + replaceFileFrom (toRawFilePath tmpfile) (toRawFilePath file) createdirectory return r -replaceFileFrom :: FilePath -> FilePath -> (RawFilePath -> Annex ()) -> Annex () +replaceFileFrom :: RawFilePath -> RawFilePath -> (RawFilePath -> Annex ()) -> Annex () replaceFileFrom src dest createdirectory = go `catchIO` fallback where go = liftIO $ moveFile src dest fallback _ = do - createdirectory (parentDir (toRawFilePath dest)) + createdirectory (parentDir dest) go diff --git a/Command/Add.hs b/Command/Add.hs index 671f16799e..17a00d7e10 100644 --- a/Command/Add.hs +++ b/Command/Add.hs @@ -28,6 +28,7 @@ import Utility.InodeCache import Annex.InodeSentinal import Annex.CheckIgnore import qualified Utility.RawFilePath as R +import qualified System.FilePath.ByteString as P import System.PosixCompat.Files @@ -208,15 +209,15 @@ start si file addunlockedmatcher = starting "add" (ActionItemTreeFile file) si $ addingExistingLink file key $ withOtherTmp $ \tmp -> do - let tmpf = fromRawFilePath tmp fromRawFilePath file - liftIO $ moveFile (fromRawFilePath file) tmpf - ifM (isSymbolicLink <$> liftIO (getSymbolicLinkStatus tmpf)) + let tmpf = tmp P. file + liftIO $ moveFile file tmpf + ifM (isSymbolicLink <$> liftIO (R.getSymbolicLinkStatus tmpf)) ( do - liftIO $ removeFile tmpf + liftIO $ R.removeLink tmpf addSymlink file key Nothing next $ cleanup key =<< inAnnex key , do - liftIO $ moveFile tmpf (fromRawFilePath file) + liftIO $ moveFile tmpf file next $ return True ) fixuppointer s key = diff --git a/Command/Fsck.hs b/Command/Fsck.hs index d93c6f1707..cac06ecfc2 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -613,7 +613,7 @@ honorDead dead badContent :: Key -> Annex String badContent key = do dest <- moveBad key - return $ "moved to " ++ dest + return $ "moved to " ++ fromRawFilePath dest {- Bad content is dropped from the remote. We have downloaded a copy - from the remote to a temp file already (in some cases, it's just a @@ -633,7 +633,7 @@ badContentRemote remote localcopy key = do ifM (isSymbolicLink <$> R.getSymbolicLinkStatus localcopy) ( copyFileExternal CopyTimeStamps (fromRawFilePath localcopy) destbad' , do - moveFile (fromRawFilePath localcopy) destbad' + moveFile localcopy destbad return True ) ) diff --git a/Command/Import.hs b/Command/Import.hs index 21d847ea50..21fd0a9bef 100644 --- a/Command/Import.hs +++ b/Command/Import.hs @@ -207,12 +207,8 @@ startLocal o addunlockedmatcher largematcher mode (srcfile, destfile) = (fromRawFilePath destfile) return $ removeWhenExistsWith R.removeLink destfile else do - moveFile - (fromRawFilePath srcfile) - (fromRawFilePath destfile) - return $ moveFile - (fromRawFilePath destfile) - (fromRawFilePath srcfile) + moveFile srcfile destfile + return $ moveFile destfile srcfile -- Make sure that the dest file has its write permissions -- removed; the src file normally already did, but may -- have imported it from a filesystem that does not allow diff --git a/Command/SetKey.hs b/Command/SetKey.hs index ec15cf87c7..e7393e13bb 100644 --- a/Command/SetKey.hs +++ b/Command/SetKey.hs @@ -38,7 +38,7 @@ perform file key = do ok <- getViaTmp RetrievalAllKeysSecure DefaultVerify key (AssociatedFile Nothing) $ \dest -> unVerified $ if dest /= file then liftIO $ catchBoolIO $ do - moveFile (fromRawFilePath file) (fromRawFilePath dest) + moveFile file dest return True else return True if ok diff --git a/Git/Repair.hs b/Git/Repair.hs index 7d47f84614..7e058e25df 100644 --- a/Git/Repair.hs +++ b/Git/Repair.hs @@ -95,7 +95,7 @@ explodePacks r = go =<< listPackFiles r let dest = objectsDir r P. f createDirectoryIfMissing True (fromRawFilePath (parentDir dest)) - moveFile objfile (fromRawFilePath dest) + moveFile (toRawFilePath objfile) dest forM_ packs $ \packfile -> do let f = toRawFilePath packfile removeWhenExistsWith R.removeLink f diff --git a/Remote/Borg.hs b/Remote/Borg.hs index 5e34256fe9..7c31038661 100644 --- a/Remote/Borg.hs +++ b/Remote/Borg.hs @@ -407,7 +407,7 @@ retrieveExportWithContentIdentifierM borgrepo loc _ dest gk _ = do forceSuccessProcess p pid -- Filepaths in borg archives are relative, so it's ok to -- combine with - moveFile (fromRawFilePath othertmp fromRawFilePath archivefile) dest + moveFile (othertmp P. archivefile) (toRawFilePath dest) removeDirectoryRecursive (fromRawFilePath othertmp) (archivename, archivefile) = extractImportLocation loc diff --git a/Remote/Helper/Chunked.hs b/Remote/Helper/Chunked.hs index 72e33fe77e..f9014074b0 100644 --- a/Remote/Helper/Chunked.hs +++ b/Remote/Helper/Chunked.hs @@ -403,7 +403,7 @@ writeRetrievedContent writeRetrievedContent dest enc encc mh mp content miv = case (enc, mh, content) of (Nothing, Nothing, FileContent f) | f == dest -> noop - | otherwise -> liftIO $ moveFile f dest + | otherwise -> liftIO $ moveFile (toRawFilePath f) (toRawFilePath dest) (Just (cipher, _), _, ByteContent b) -> do cmd <- gpgCmd <$> Annex.getGitConfig decrypt cmd encc cipher (feedBytes b) $ diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs index e2ac08a616..ab3c0b42ed 100644 --- a/Remote/Rsync.hs +++ b/Remote/Rsync.hs @@ -226,7 +226,7 @@ store o k src meterupdate = storeGeneric o meterupdate basedest populatedest then do rename src dest return True - else createLinkOrCopy src dest + else createLinkOrCopy (toRawFilePath src) (toRawFilePath dest) {- If the key being sent is encrypted or chunked, the file - containing its content is a temp file, and so can be - renamed into place. Otherwise, the file is the annexed @@ -315,7 +315,7 @@ storeExportM o src _k loc meterupdate = storeGeneric o meterupdate basedest populatedest where basedest = fromRawFilePath (fromExportLocation loc) - populatedest = liftIO . createLinkOrCopy src + populatedest = liftIO . createLinkOrCopy (toRawFilePath src) . toRawFilePath retrieveExportM :: RsyncOpts -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Verification retrieveExportM o k loc dest p = diff --git a/Utility/CopyFile.hs b/Utility/CopyFile.hs index 9c93e70199..59e1ca278d 100644 --- a/Utility/CopyFile.hs +++ b/Utility/CopyFile.hs @@ -14,6 +14,7 @@ module Utility.CopyFile ( import Common import qualified BuildInfo +import qualified Utility.RawFilePath as R data CopyMetaData -- Copy timestamps when possible, but no other metadata, and @@ -86,10 +87,10 @@ copyCoW meta src dest {- Create a hard link if the filesystem allows it, and fall back to copying - the file. -} -createLinkOrCopy :: FilePath -> FilePath -> IO Bool +createLinkOrCopy :: RawFilePath -> RawFilePath -> IO Bool createLinkOrCopy src dest = go `catchIO` const fallback where go = do - createLink src dest + R.createLink src dest return True - fallback = copyFileExternal CopyAllMetaData src dest + fallback = copyFileExternal CopyAllMetaData (fromRawFilePath src) (fromRawFilePath dest) diff --git a/Utility/MoveFile.hs b/Utility/MoveFile.hs index 3ea17e8405..ebce9ac39d 100644 --- a/Utility/MoveFile.hs +++ b/Utility/MoveFile.hs @@ -14,8 +14,7 @@ module Utility.MoveFile ( ) where import Control.Monad -import System.FilePath -import System.PosixCompat.Files hiding (removeLink) +import System.PosixCompat.Files (isDirectory) import System.IO.Error import Prelude @@ -28,17 +27,19 @@ import Utility.SystemDirectory import Utility.Tmp import Utility.Exception import Utility.Monad +import Utility.FileSystemEncoding +import qualified Utility.RawFilePath as R {- Moves one filename to another. - First tries a rename, but falls back to moving across devices if needed. -} -moveFile :: FilePath -> FilePath -> IO () -moveFile src dest = tryIO (rename src dest) >>= onrename +moveFile :: RawFilePath -> RawFilePath -> IO () +moveFile src dest = tryIO (R.rename src dest) >>= onrename where onrename (Right _) = noop onrename (Left e) | isPermissionError e = rethrow | isDoesNotExistError e = rethrow - | otherwise = viaTmp mv dest () + | otherwise = viaTmp mv (fromRawFilePath dest) () where rethrow = throwM e @@ -46,16 +47,20 @@ moveFile src dest = tryIO (rename src dest) >>= onrename -- copyFile is likely not as optimised as -- the mv command, so we'll use the command. -- - -- But, while Windows has a "mv", it does not seem very - -- reliable, so use copyFile there. + -- But, while Windows has a "mv", it does not + -- seem very reliable, so use copyFile there. #ifndef mingw32_HOST_OS -- If dest is a directory, mv would move the file -- into it, which is not desired. whenM (isdir dest) rethrow - ok <- boolSystem "mv" [Param "-f", Param src, Param tmp] + ok <- boolSystem "mv" + [ Param "-f" + , Param (fromRawFilePath src) + , Param tmp + ] let e' = e #else - r <- tryIO $ copyFile src tmp + r <- tryIO $ copyFile (fromRawFilePath src) tmp let (ok, e') = case r of Left err -> (False, err) Right _ -> (True, e) @@ -67,7 +72,7 @@ moveFile src dest = tryIO (rename src dest) >>= onrename #ifndef mingw32_HOST_OS isdir f = do - r <- tryIO $ getFileStatus f + r <- tryIO $ R.getFileStatus f case r of (Left _) -> return False (Right s) -> return $ isDirectory s diff --git a/Utility/RawFilePath.hs b/Utility/RawFilePath.hs index f32b2260f8..4ee347668d 100644 --- a/Utility/RawFilePath.hs +++ b/Utility/RawFilePath.hs @@ -27,6 +27,7 @@ module Utility.RawFilePath ( getCurrentDirectory, createDirectory, setFileMode, + rename, ) where #ifndef mingw32_HOST_OS @@ -87,4 +88,7 @@ createDirectory = D.createDirectory . fromRawFilePath setFileMode :: RawFilePath -> FileMode -> IO () setFileMode = F.setFileMode . fromRawFilePath + +rename :: RawFilePath -> RawFilePath -> IO () +rename a b = F.rename (fromRawFilePath a) (fromRawFilePath b) #endif