diff --git a/Annex/AutoMerge.hs b/Annex/AutoMerge.hs index 33fccd7751..f0e3ad8fa9 100644 --- a/Annex/AutoMerge.hs +++ b/Annex/AutoMerge.hs @@ -34,11 +34,11 @@ import qualified Database.Keys import Annex.InodeSentinal import Utility.InodeCache import Utility.FileMode +import qualified Utility.RawFilePath as R import qualified Data.Set as S import qualified Data.Map as M import qualified Data.ByteString.Lazy as L -import qualified Utility.RawFilePath as R {- Merges from a branch into the current branch (which may not exist yet), - with automatic merge conflict resolution. @@ -176,7 +176,7 @@ resolveMerge' unstagedmap (Just us) them inoverlay u = do -- files, so delete here. unless inoverlay $ unless (islocked LsFiles.valUs) $ - liftIO $ removeWhenExistsWith removeLink file + liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath file) | otherwise -> do -- Only resolve using symlink when both -- were locked, otherwise use unlocked @@ -309,7 +309,7 @@ cleanConflictCruft resolvedks resolvedfs unstagedmap = do <$> mapM Database.Keys.getInodeCaches resolvedks forM_ (M.toList unstagedmap) $ \(i, f) -> whenM (matchesresolved is i f) $ - liftIO $ removeWhenExistsWith removeLink f + liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath f) where fs = S.fromList resolvedfs ks = S.fromList resolvedks diff --git a/Annex/Branch.hs b/Annex/Branch.hs index 415980447b..6b497377a2 100644 --- a/Annex/Branch.hs +++ b/Annex/Branch.hs @@ -535,7 +535,7 @@ stageJournal jl commitindex = withIndex $ withOtherTmp $ \tmpdir -> do stagedfs <- lines <$> hGetContents jlogh mapM_ (removeFile . (dir )) stagedfs hClose jlogh - removeWhenExistsWith removeLink jlogf + removeWhenExistsWith (R.removeLink) (toRawFilePath jlogf) openjlog tmpdir = liftIO $ openTempFile tmpdir "jlog" {- This is run after the refs have been merged into the index, diff --git a/Annex/Content/LowLevel.hs b/Annex/Content/LowLevel.hs index f202e6e8cf..c686e462e2 100644 --- a/Annex/Content/LowLevel.hs +++ b/Annex/Content/LowLevel.hs @@ -18,7 +18,6 @@ import Utility.DataUnits import Utility.CopyFile import qualified Utility.RawFilePath as R -import System.PosixCompat.Files import qualified System.FilePath.ByteString as P {- Runs the secure erase command if set, otherwise does nothing. @@ -75,8 +74,9 @@ checkedCopyFile key src dest destmode = catchBoolIO $ =<< liftIO (R.getFileStatus src) checkedCopyFile' :: Key -> RawFilePath -> RawFilePath -> Maybe FileMode -> FileStatus -> Annex Bool -checkedCopyFile' key src dest destmode s = catchBoolIO $ - ifM (checkDiskSpace' (fromIntegral $ fileSize s) (Just $ P.takeDirectory dest) key 0 True) +checkedCopyFile' key src dest destmode s = catchBoolIO $ do + sz <- liftIO $ getFileSize' src s + ifM (checkDiskSpace' sz (Just $ P.takeDirectory dest) key 0 True) ( liftIO $ copyFileExternal CopyAllMetaData (fromRawFilePath src) (fromRawFilePath dest) <&&> preserveGitMode dest destmode diff --git a/Annex/Content/PointerFile.hs b/Annex/Content/PointerFile.hs index 1e23167a42..0ce60ef06e 100644 --- a/Annex/Content/PointerFile.hs +++ b/Annex/Content/PointerFile.hs @@ -9,12 +9,6 @@ module Annex.Content.PointerFile where -#if ! defined(mingw32_HOST_OS) -import System.Posix.Files -#else -import System.PosixCompat.Files -#endif - import Annex.Common import Annex.Perms import Annex.Link @@ -22,10 +16,11 @@ import Annex.ReplaceFile import Annex.InodeSentinal import Annex.Content.LowLevel import Utility.InodeCache +import qualified Utility.RawFilePath as R #if ! defined(mingw32_HOST_OS) import Utility.Touch +import System.Posix.Files (modificationTimeHiRes) #endif -import qualified Utility.RawFilePath as R {- Populates a pointer file with the content of a key. - diff --git a/Annex/Ingest.hs b/Annex/Ingest.hs index 6aeeea25cd..c240ca152f 100644 --- a/Annex/Ingest.hs +++ b/Annex/Ingest.hs @@ -49,9 +49,9 @@ import Git.FilePath import Annex.InodeSentinal import Annex.AdjustedBranch import Annex.FileMatcher +import qualified Utility.RawFilePath as R import Control.Exception (IOException) -import qualified Utility.RawFilePath as R data LockedDown = LockedDown { lockDownConfig :: LockDownConfig @@ -113,7 +113,7 @@ lockDown' cfg file = tryIO $ ifM crippledFileSystem (tmpfile, h) <- openTempFile (fromRawFilePath tmpdir) $ relatedTemplate $ "ingest-" ++ takeFileName file hClose h - removeWhenExistsWith removeLink tmpfile + removeWhenExistsWith R.removeLink (toRawFilePath tmpfile) withhardlink' delta tmpfile `catchIO` const (nohardlink' delta) diff --git a/Annex/Init.hs b/Annex/Init.hs index 4ece574b9e..fc6d2a7f04 100644 --- a/Annex/Init.hs +++ b/Annex/Init.hs @@ -49,8 +49,8 @@ import Annex.InodeSentinal import Upgrade import Annex.Tmp import Utility.UserInfo -#ifndef mingw32_HOST_OS import qualified Utility.RawFilePath as R +#ifndef mingw32_HOST_OS import Utility.ThreadScheduler import Annex.Perms import Utility.FileMode @@ -212,9 +212,9 @@ probeCrippledFileSystem' tmp = do where probe f = catchDefaultIO (True, []) $ do let f2 = f ++ "2" - removeWhenExistsWith removeLink f2 + removeWhenExistsWith R.removeLink (toRawFilePath f2) createSymbolicLink f f2 - removeWhenExistsWith removeLink f2 + removeWhenExistsWith R.removeLink (toRawFilePath f2) preventWrite (toRawFilePath f) -- Should be unable to write to the file, unless -- running as root, but some crippled diff --git a/Annex/Ssh.hs b/Annex/Ssh.hs index 08d26dfadc..3abf8e3e0a 100644 --- a/Annex/Ssh.hs +++ b/Annex/Ssh.hs @@ -337,7 +337,7 @@ forceStopSsh socketfile = withNullHandle $ \nullh -> do } void $ liftIO $ catchMaybeIO $ withCreateProcess p $ \_ _ _ pid -> forceSuccessProcess p pid - liftIO $ removeWhenExistsWith removeLink socketfile + liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath socketfile) {- This needs to be as short as possible, due to limitations on the length - of the path to a socket file. At the same time, it needs to be unique diff --git a/Annex/Tmp.hs b/Annex/Tmp.hs index f7d1720467..b19daeb18d 100644 --- a/Annex/Tmp.hs +++ b/Annex/Tmp.hs @@ -12,6 +12,7 @@ import qualified Annex import Annex.LockFile import Annex.Perms import Types.CleanupActions +import qualified Utility.RawFilePath as R import Data.Time.Clock.POSIX @@ -67,5 +68,5 @@ cleanupOtherTmp = do let oldenough = now - (60 * 60 * 24 * 7) catchMaybeIO (modificationTime <$> getSymbolicLinkStatus f) >>= \case Just mtime | realToFrac mtime <= oldenough -> - void $ tryIO $ removeWhenExistsWith removeLink f + void $ tryIO $ removeWhenExistsWith R.removeLink (toRawFilePath f) _ -> return () diff --git a/Assistant/Repair.hs b/Assistant/Repair.hs index 2d0f176b32..96e8e1904a 100644 --- a/Assistant/Repair.hs +++ b/Assistant/Repair.hs @@ -30,6 +30,7 @@ import qualified Data.Text as T #endif import qualified Utility.Lsof as Lsof import Utility.ThreadScheduler +import qualified Utility.RawFilePath as R import Control.Concurrent.Async @@ -149,7 +150,7 @@ repairStaleLocks lockfiles = go =<< getsizes waitforit "to check stale git lock file" l' <- getsizes if l' == l - then liftIO $ mapM_ (removeWhenExistsWith removeLink . fst) l + then liftIO $ mapM_ (removeWhenExistsWith R.removeLink . toRawFilePath . fst) l else go l' , do waitforit "for git lock file writer" diff --git a/Assistant/Upgrade.hs b/Assistant/Upgrade.hs index b61eff54c0..77ccaaf610 100644 --- a/Assistant/Upgrade.hs +++ b/Assistant/Upgrade.hs @@ -41,6 +41,7 @@ import qualified BuildInfo import qualified Utility.Url as Url import qualified Annex.Url as Url hiding (download) import Utility.Tuple +import qualified Utility.RawFilePath as R import Data.Either import qualified Data.Map as M @@ -220,7 +221,7 @@ upgradeToDistribution newdir cleanup distributionfile = do error $ "did not find " ++ dir ++ " in " ++ distributionfile makeorigsymlink olddir = do let origdir = fromRawFilePath (parentDir (toRawFilePath olddir)) installBase - removeWhenExistsWith removeLink origdir + removeWhenExistsWith R.removeLink (toRawFilePath origdir) createSymbolicLink newdir origdir {- Finds where the old version was installed. -} @@ -278,8 +279,8 @@ installBase = "git-annex." ++ deleteFromManifest :: FilePath -> IO () deleteFromManifest dir = do fs <- map (dir ) . lines <$> catchDefaultIO "" (readFile manifest) - mapM_ (removeWhenExistsWith removeLink) fs - removeWhenExistsWith removeLink manifest + mapM_ (removeWhenExistsWith R.removeLink . toRawFilePath) fs + removeWhenExistsWith R.removeLink (toRawFilePath manifest) removeEmptyRecursive dir where manifest = dir "git-annex.MANIFEST" diff --git a/Command/FuzzTest.hs b/Command/FuzzTest.hs index bad58d14fe..20296c379d 100644 --- a/Command/FuzzTest.hs +++ b/Command/FuzzTest.hs @@ -17,6 +17,7 @@ import Annex.Perms import Utility.ThreadScheduler import Utility.DiskFree import Git.Types (fromConfigKey) +import qualified Utility.RawFilePath as R import Data.Time.Clock import System.Random (getStdRandom, random, randomR) @@ -178,7 +179,7 @@ runFuzzAction (FuzzAdd (FuzzFile f)) = do n <- liftIO (getStdRandom random :: IO Int) liftIO $ writeFile f $ show n ++ "\n" runFuzzAction (FuzzDelete (FuzzFile f)) = liftIO $ - removeWhenExistsWith removeLink f + removeWhenExistsWith R.removeLink (toRawFilePath f) runFuzzAction (FuzzMove (FuzzFile src) (FuzzFile dest)) = liftIO $ rename src dest runFuzzAction (FuzzDeleteDir (FuzzDir d)) = liftIO $ diff --git a/Command/Multicast.hs b/Command/Multicast.hs index f6e29b6f90..06599202e6 100644 --- a/Command/Multicast.hs +++ b/Command/Multicast.hs @@ -27,6 +27,7 @@ import Utility.Hash import Utility.Tmp import Utility.Tmp.Dir import Utility.Process.Transcript +import qualified Utility.RawFilePath as R import Data.Char import qualified Data.ByteString.Lazy.UTF8 as B8 @@ -84,7 +85,7 @@ genAddress = starting "gen-address" (ActionItemOther Nothing) (SeekInput []) $ d KeyContainer s -> liftIO $ genkey (Param s) KeyFile f -> do createAnnexDirectory (toRawFilePath (takeDirectory f)) - liftIO $ removeWhenExistsWith removeLink f + liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath f) liftIO $ protectedOutput $ genkey (File f) case (ok, parseFingerprint s) of (False, _) -> giveup $ "uftp_keymgt failed: " ++ s @@ -210,7 +211,7 @@ storeReceived f = do case deserializeKey (takeFileName f) of Nothing -> do warning $ "Received a file " ++ f ++ " that is not a git-annex key. Deleting this file." - liftIO $ removeWhenExistsWith removeLink f + liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath f) Just k -> void $ getViaTmpFromDisk RetrievalVerifiableKeysSecure AlwaysVerify k (AssociatedFile Nothing) $ \dest -> unVerified $ liftIO $ catchBoolIO $ do diff --git a/Command/P2P.hs b/Command/P2P.hs index d3eca898e1..5e7c3d3178 100644 --- a/Command/P2P.hs +++ b/Command/P2P.hs @@ -24,6 +24,7 @@ import Utility.AuthToken import Utility.Tmp.Dir import Utility.FileMode import Utility.ThreadScheduler +import qualified Utility.RawFilePath as R import qualified Utility.MagicWormhole as Wormhole import Control.Concurrent.Async @@ -256,7 +257,7 @@ wormholePairing remotename ouraddrs ui = do Wormhole.sendFile sendf observer wormholeparams `concurrently` Wormhole.receiveFile recvf producer wormholeparams - liftIO $ removeWhenExistsWith removeLink sendf + liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath sendf) if sendres /= True then return SendFailed else if recvres /= True diff --git a/Command/Vicfg.hs b/Command/Vicfg.hs index a2029bcafb..443570eb85 100644 --- a/Command/Vicfg.hs +++ b/Command/Vicfg.hs @@ -32,6 +32,7 @@ import Types.ScheduledActivity import Types.NumCopies import Remote import Git.Types (fromConfigKey, fromConfigValue) +import qualified Utility.RawFilePath as R cmd :: Command cmd = command "vicfg" SectionSetup "edit configuration in git-annex branch" @@ -58,7 +59,7 @@ vicfg curcfg f = do unlessM (liftIO $ boolSystem "sh" [Param "-c", Param $ unwords [vi, shellEscape f]]) $ giveup $ vi ++ " exited nonzero; aborting" r <- parseCfg (defCfg curcfg) <$> liftIO (readFileStrict f) - liftIO $ removeWhenExistsWith removeLink f + liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath f) case r of Left s -> do liftIO $ writeFile f s diff --git a/Common.hs b/Common.hs index 95029bca99..dafc291771 100644 --- a/Common.hs +++ b/Common.hs @@ -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) +import System.PosixCompat.Files as X hiding (fileSize, removeLink) import Utility.Misc as X import Utility.Exception as X diff --git a/Creds.hs b/Creds.hs index 58f1ca1165..86acd016cb 100644 --- a/Creds.hs +++ b/Creds.hs @@ -32,12 +32,13 @@ import Crypto import Types.ProposedAccepted import Remote.Helper.Encryptable (remoteCipher, remoteCipher', embedCreds, EncryptionIsSetup, extractCipher) import Utility.Env (getEnv) +import Utility.Base64 +import qualified Utility.RawFilePath as R import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.ByteString.Char8 as S import qualified Data.Map as M import qualified System.FilePath.ByteString as P -import Utility.Base64 {- A CredPair can be stored in a file, or in the environment, or - in a remote's configuration. -} @@ -211,9 +212,8 @@ decodeCredPair creds = case lines creds of removeCreds :: FilePath -> Annex () removeCreds file = do - d <- fromRawFilePath <$> fromRepo gitAnnexCredsDir - let f = d file - liftIO $ removeWhenExistsWith removeLink f + d <- fromRepo gitAnnexCredsDir + liftIO $ removeWhenExistsWith R.removeLink (d P. toRawFilePath file) includeCredsInfo :: ParsedRemoteConfig -> CredPairStorage -> [(String, String)] -> Annex [(String, String)] includeCredsInfo pc@(ParsedRemoteConfig cm _) storage info = do diff --git a/Git/Repair.hs b/Git/Repair.hs index 45d9d7c489..ea682a2973 100644 --- a/Git/Repair.hs +++ b/Git/Repair.hs @@ -5,6 +5,8 @@ - Licensed under the GNU AGPL version 3 or higher. -} +{-# LANGUAGE OverloadedStrings #-} + module Git.Repair ( runRepair, runRepairOf, @@ -243,11 +245,12 @@ getAllRefs' refdir = do explodePackedRefsFile :: Repo -> IO () explodePackedRefsFile r = do let f = packedRefsFile r + let f' = toRawFilePath f whenM (doesFileExist f) $ do rs <- mapMaybe parsePacked . lines - <$> catchDefaultIO "" (safeReadFile f) + <$> catchDefaultIO "" (safeReadFile f') forM_ rs makeref - removeWhenExistsWith removeLink f + removeWhenExistsWith R.removeLink f' where makeref (sha, ref) = do let gitd = localGitDir r @@ -444,13 +447,13 @@ displayList items header preRepair :: Repo -> IO () preRepair g = do unlessM (validhead <$> catchDefaultIO "" (safeReadFile headfile)) $ do - removeWhenExistsWith removeLink headfile - writeFile headfile "ref: refs/heads/master" + removeWhenExistsWith R.removeLink headfile + writeFile (fromRawFilePath headfile) "ref: refs/heads/master" explodePackedRefsFile g unless (repoIsLocalBare g) $ void $ tryIO $ allowWrite $ indexFile g where - headfile = fromRawFilePath (localGitDir g) "HEAD" + headfile = localGitDir g P. "HEAD" validhead s = "ref: refs/" `isPrefixOf` s || isJust (extractSha (encodeBS' s)) @@ -616,7 +619,7 @@ runRepair' removablebranch fsckresult forced referencerepo g = do successfulRepair :: (Bool, [Branch]) -> Bool successfulRepair = fst -safeReadFile :: FilePath -> IO String +safeReadFile :: RawFilePath -> IO String safeReadFile f = do - allowRead (toRawFilePath f) - readFileStrict f + allowRead f + readFileStrict (fromRawFilePath f) diff --git a/P2P/IO.hs b/P2P/IO.hs index 11aa8deca0..9a71ba89f0 100644 --- a/P2P/IO.hs +++ b/P2P/IO.hs @@ -37,6 +37,7 @@ import Utility.Tor import Utility.FileMode import Types.UUID import Annex.ChangedRefs +import qualified Utility.RawFilePath as R import Control.Monad.Free import Control.Monad.IO.Class @@ -124,7 +125,7 @@ closeConnection conn = do -- the callback. serveUnixSocket :: FilePath -> (Handle -> IO ()) -> IO () serveUnixSocket unixsocket serveconn = do - removeWhenExistsWith removeLink unixsocket + removeWhenExistsWith R.removeLink (toRawFilePath unixsocket) soc <- S.socket S.AF_UNIX S.Stream S.defaultProtocol S.bind soc (S.SockAddrUnix unixsocket) -- Allow everyone to read and write to the socket, diff --git a/Remote/Directory.hs b/Remote/Directory.hs index bc5d2ab3b6..4be5850bb5 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -301,10 +301,10 @@ retrieveExportM d _k loc dest p = removeExportM :: RawFilePath -> Key -> ExportLocation -> Annex () removeExportM d _k loc = liftIO $ do - removeWhenExistsWith removeLink src + removeWhenExistsWith R.removeLink src removeExportLocation d loc where - src = fromRawFilePath $ exportPath d loc + src = exportPath d loc checkPresentExportM :: RawFilePath -> Key -> ExportLocation -> Annex Bool checkPresentExportM d _k loc = diff --git a/Remote/Directory/LegacyChunked.hs b/Remote/Directory/LegacyChunked.hs index 3415037994..9b3d0e2ab8 100644 --- a/Remote/Directory/LegacyChunked.hs +++ b/Remote/Directory/LegacyChunked.hs @@ -22,6 +22,7 @@ import qualified Remote.Helper.Chunked.Legacy as Legacy import Annex.Tmp import Utility.Metered import Utility.Directory.Create +import qualified Utility.RawFilePath as R withCheckedFiles :: (FilePath -> IO Bool) -> FilePath -> (FilePath -> Key -> [FilePath]) -> Key -> ([FilePath] -> IO Bool) -> IO Bool withCheckedFiles _ [] _locations _ _ = return False @@ -98,15 +99,15 @@ store repotop chunksize finalizer k b p = storeHelper repotop finalizer k $ \des retrieve :: (RawFilePath -> Key -> [RawFilePath]) -> RawFilePath -> Retriever retrieve locations d basek p c = withOtherTmp $ \tmpdir -> do showLongNote "This remote uses the deprecated chunksize setting. So this will be quite slow." - let tmp = fromRawFilePath $ - tmpdir P. keyFile basek <> ".directorylegacy.tmp" + let tmp = tmpdir P. keyFile basek <> ".directorylegacy.tmp" + let tmp' = fromRawFilePath tmp let go = \k sink -> do liftIO $ void $ withStoredFiles (fromRawFilePath d) (legacyLocations locations) k $ \fs -> do forM_ fs $ - S.appendFile tmp <=< S.readFile + S.appendFile tmp' <=< S.readFile return True - b <- liftIO $ L.readFile tmp - liftIO $ removeWhenExistsWith removeLink tmp + b <- liftIO $ L.readFile tmp' + liftIO $ removeWhenExistsWith R.removeLink tmp sink b byteRetriever go basek p c diff --git a/Remote/Helper/Special.hs b/Remote/Helper/Special.hs index b263f707b5..ce1ebe22a0 100644 --- a/Remote/Helper/Special.hs +++ b/Remote/Helper/Special.hs @@ -51,6 +51,7 @@ import Messages.Progress import qualified Git import qualified Git.Construct import Git.Types +import qualified Utility.RawFilePath as R import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L @@ -284,10 +285,10 @@ sink dest enc c mh mp content = case (enc, mh, content) of withBytes content $ \b -> decrypt cmd c cipher (feedBytes b) $ readBytes write - liftIO $ removeWhenExistsWith removeLink f + liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath f) (Nothing, _, FileContent f) -> do withBytes content write - liftIO $ removeWhenExistsWith removeLink f + liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath f) (Nothing, _, ByteContent b) -> write b where write b = case mh of diff --git a/Test.hs b/Test.hs index 91083d4d64..6c1878d225 100644 --- a/Test.hs +++ b/Test.hs @@ -412,7 +412,7 @@ test_ignore_deleted_files :: Assertion test_ignore_deleted_files = intmpclonerepo $ do git_annex "get" [annexedfile] @? "get failed" git_annex_expectoutput "find" [] [annexedfile] - removeWhenExistsWith removeLink annexedfile + removeWhenExistsWith R.removeLink (toRawFilePath annexedfile) -- A file that has been deleted, but the deletion not staged, -- is a special case; make sure git-annex skips these. git_annex_expectoutput "find" [] [] @@ -1332,7 +1332,7 @@ test_remove_conflict_resolution = do @? "unlock conflictor failed" writecontent conflictor "newconflictor" indir r1 $ - removeWhenExistsWith removeLink conflictor + removeWhenExistsWith R.removeLink (toRawFilePath conflictor) let l = if inr1 then [r1, r2, r1] else [r2, r1, r2] forM_ l $ \r -> indir r $ git_annex "sync" [] @? "sync failed" @@ -1861,7 +1861,7 @@ test_export_import = intmpclonerepo $ do git_annex "merge" ["foo/" ++ origbranch] @? "git annex merge failed" annexed_present_imported "import" - removeWhenExistsWith removeLink "import" + removeWhenExistsWith R.removeLink (toRawFilePath "import") writecontent "import" (content "newimport1") git_annex "add" ["import"] @? "add of import failed" commitchanges @@ -1870,7 +1870,7 @@ test_export_import = intmpclonerepo $ do -- verify that export refuses to overwrite modified file writedir "import" (content "newimport2") - removeWhenExistsWith removeLink "import" + removeWhenExistsWith R.removeLink (toRawFilePath "import") writecontent "import" (content "newimport3") git_annex "add" ["import"] @? "add of import failed" commitchanges @@ -1880,7 +1880,7 @@ test_export_import = intmpclonerepo $ do -- resolving import conflict git_annex "import" [origbranch, "--from", "foo"] @? "import from dir failed" not <$> boolSystem "git" [Param "merge", Param "foo/master", Param "-mmerge"] @? "git merge of conflict failed to exit nonzero" - removeWhenExistsWith removeLink "import" + removeWhenExistsWith R.removeLink (toRawFilePath "import") writecontent "import" (content "newimport3") git_annex "add" ["import"] @? "add of import failed" commitchanges diff --git a/Upgrade/V5.hs b/Upgrade/V5.hs index 98e60601f1..bed8a6d801 100644 --- a/Upgrade/V5.hs +++ b/Upgrade/V5.hs @@ -32,6 +32,7 @@ import Git.Ref import Utility.InodeCache import Utility.DottedVersion import Annex.AdjustedBranch +import qualified Utility.RawFilePath as R import qualified Data.ByteString as S @@ -156,7 +157,7 @@ upgradeDirectWorkTree = do ) writepointer f k = liftIO $ do - removeWhenExistsWith removeLink f + removeWhenExistsWith R.removeLink (toRawFilePath f) S.writeFile f (formatPointer k) {- Remove all direct mode bookkeeping files. -} diff --git a/Utility/Directory.hs b/Utility/Directory.hs index 54ca7186b6..38adf17059 100644 --- a/Utility/Directory.hs +++ b/Utility/Directory.hs @@ -16,7 +16,7 @@ module Utility.Directory ( import Control.Monad import System.FilePath -import System.PosixCompat.Files +import System.PosixCompat.Files hiding (removeLink) import Control.Applicative import System.IO.Unsafe (unsafeInterleaveIO) import Data.Maybe diff --git a/Utility/FileMode.hs b/Utility/FileMode.hs index 03e838e8a5..6725601945 100644 --- a/Utility/FileMode.hs +++ b/Utility/FileMode.hs @@ -16,7 +16,7 @@ module Utility.FileMode ( import System.IO import Control.Monad import System.PosixCompat.Types -import System.PosixCompat.Files +import System.PosixCompat.Files hiding (removeLink) import Control.Monad.IO.Class import Foreign (complement) import Control.Monad.Catch diff --git a/Utility/FileSize.hs b/Utility/FileSize.hs index 0669afa01b..a503fda002 100644 --- a/Utility/FileSize.hs +++ b/Utility/FileSize.hs @@ -14,7 +14,7 @@ module Utility.FileSize ( getFileSize', ) where -import System.PosixCompat.Files +import System.PosixCompat.Files hiding (removeLink) import qualified Utility.RawFilePath as R #ifdef mingw32_HOST_OS import Control.Exception (bracket) diff --git a/Utility/MoveFile.hs b/Utility/MoveFile.hs index 2bc3a8d287..3ea17e8405 100644 --- a/Utility/MoveFile.hs +++ b/Utility/MoveFile.hs @@ -15,7 +15,7 @@ module Utility.MoveFile ( import Control.Monad import System.FilePath -import System.PosixCompat.Files +import System.PosixCompat.Files hiding (removeLink) import System.IO.Error import Prelude diff --git a/Utility/Tmp.hs b/Utility/Tmp.hs index 4d46c69140..5877f68634 100644 --- a/Utility/Tmp.hs +++ b/Utility/Tmp.hs @@ -20,7 +20,7 @@ import System.IO import System.FilePath import System.Directory import Control.Monad.IO.Class -import System.PosixCompat.Files +import System.PosixCompat.Files hiding (removeLink) import Utility.Exception import Utility.FileSystemEncoding