diff --git a/Annex/Branch.hs b/Annex/Branch.hs index d94391aaf8..9cdb1267fa 100644 --- a/Annex/Branch.hs +++ b/Annex/Branch.hs @@ -771,7 +771,7 @@ stageJournal jl commitindex = withIndex $ withOtherTmp $ \tmpdir -> do stagedfs <- lines <$> hGetContents jlogh mapM_ (removeFile . (dir ) . toOsPath) stagedfs hClose jlogh - removeWhenExistsWith (R.removeLink) (fromOsPath jlogf) + removeWhenExistsWith removeFile jlogf openjlog tmpdir = liftIO $ openTmpFileIn tmpdir (literalOsPath "jlog") getLocalTransitions :: Annex Transitions diff --git a/Annex/Content.hs b/Annex/Content.hs index 42f33a64fd..a6b8423386 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -370,7 +370,7 @@ lockContentUsing contentlocker key fallback a = withContentLockFile key $ \mlock cleanuplockfile lockfile = void $ tryNonAsync $ do thawContentDir lockfile - liftIO $ removeWhenExistsWith R.removeLink $ fromOsPath lockfile + liftIO $ removeWhenExistsWith removeFile lockfile cleanObjectDirs lockfile {- Runs an action, passing it the temp file to get, @@ -437,7 +437,7 @@ verificationOfContentFailed :: OsPath -> Annex () verificationOfContentFailed tmpfile = do warning "Verification of content failed" pruneTmpWorkDirBefore tmpfile - (liftIO . removeWhenExistsWith R.removeLink . fromOsPath) + (liftIO . removeWhenExistsWith removeFile) {- Checks if there is enough free disk space to download a key - to its temp file. @@ -476,7 +476,7 @@ withTmp :: Key -> (OsPath -> Annex a) -> Annex a withTmp key action = do tmp <- prepTmp key res <- action tmp - pruneTmpWorkDirBefore tmp (liftIO . removeWhenExistsWith R.removeLink . fromOsPath) + pruneTmpWorkDirBefore tmp (liftIO . removeWhenExistsWith removeFile) return res {- Moves a key's content into .git/annex/objects/ @@ -539,7 +539,7 @@ moveAnnex key af src = ifM (checkSecureHashes' key) Database.Keys.addInodeCaches key (catMaybes (destic:ics)) ) - alreadyhave = liftIO $ R.removeLink $ fromOsPath src + alreadyhave = liftIO $ removeFile src checkSecureHashes :: Key -> Annex (Maybe String) checkSecureHashes key = ifM (Backend.isCryptographicallySecureKey key) @@ -635,7 +635,7 @@ linkAnnex fromto key src (Just srcic) dest destmode = catMaybes [destic, Just srcic] return LinkAnnexOk _ -> do - liftIO $ removeWhenExistsWith R.removeLink $ fromOsPath dest + liftIO $ removeWhenExistsWith removeFile dest failed {- Removes the annex object file for a key. Lowlevel. -} @@ -644,7 +644,7 @@ unlinkAnnex key = do obj <- calcRepo (gitAnnexLocation key) modifyContentDir obj $ do secureErase obj - liftIO $ removeWhenExistsWith R.removeLink $ fromOsPath obj + liftIO $ removeWhenExistsWith removeFile obj {- Runs an action to transfer an object's content. The action is also - passed the size of the object. @@ -767,7 +767,7 @@ removeAnnex :: ContentRemovalLock -> Annex () removeAnnex (ContentRemovalLock key) = withObjectLoc key $ \file -> cleanObjectLoc key $ do secureErase file - liftIO $ removeWhenExistsWith R.removeLink $ fromOsPath file + liftIO $ removeWhenExistsWith removeFile file g <- Annex.gitRepo mapM_ (\f -> void $ tryIO $ resetpointer $ fromTopFilePath f g) =<< Database.Keys.getAssociatedFiles key @@ -945,7 +945,7 @@ staleKeysPrune dirspec nottransferred = do dir <- fromRepo dirspec forM_ dups $ \k -> pruneTmpWorkDirBefore (dir keyFile k) - (liftIO . R.removeLink . fromOsPath) + (liftIO . removeFile) if nottransferred then do @@ -1117,6 +1117,6 @@ checkRetentionTimestamp key locker = do - time. -} removeRetentionTimeStamp :: Key -> OsPath -> Annex () removeRetentionTimeStamp key rt = modifyContentDirWhenExists rt $ do - liftIO $ removeWhenExistsWith R.removeLink $ fromOsPath rt + liftIO $ removeWhenExistsWith removeFile rt rtl <- calcRepo (gitAnnexContentRetentionTimestampLock key) - liftIO $ removeWhenExistsWith R.removeLink $ fromOsPath rtl + liftIO $ removeWhenExistsWith removeFile rtl diff --git a/Annex/Ssh.hs b/Annex/Ssh.hs index 08fec3032d..fc6e3de61e 100644 --- a/Annex/Ssh.hs +++ b/Annex/Ssh.hs @@ -340,7 +340,7 @@ forceStopSsh socketfile = withNullHandle $ \nullh -> do } void $ liftIO $ catchMaybeIO $ withCreateProcess p $ \_ _ _ pid -> forceSuccessProcess p pid - liftIO $ removeWhenExistsWith R.removeLink (fromOsPath socketfile) + liftIO $ removeWhenExistsWith removeFile 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/Creds.hs b/Creds.hs index 02fc67c3a9..3249e8d376 100644 --- a/Creds.hs +++ b/Creds.hs @@ -223,7 +223,7 @@ decodeCredPair creds = case lines creds of removeCreds :: OsPath -> Annex () removeCreds file = do d <- fromRepo gitAnnexCredsDir - liftIO $ removeWhenExistsWith R.removeLink (fromOsPath (d file)) + liftIO $ removeWhenExistsWith removeFile (d 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 904cca52b7..0e0fa556bf 100644 --- a/Git/Repair.hs +++ b/Git/Repair.hs @@ -58,8 +58,7 @@ cleanCorruptObjects fsckresults r = do mapM_ removeLoose (S.toList $ knownMissing fsckresults) mapM_ removeBad =<< listLooseObjectShas r where - removeLoose s = removeWhenExistsWith R.removeLink $ - fromOsPath $ looseObjectFile r s + removeLoose s = removeWhenExistsWith removeFile $ looseObjectFile r s removeBad s = do void $ tryIO $ allowRead $ looseObjectFile r s whenM (isMissing s r) $ @@ -97,8 +96,8 @@ explodePacks r = go =<< listPackFiles r createDirectoryIfMissing True (parentDir dest) moveFile objfile dest forM_ packs $ \packfile -> do - removeWhenExistsWith R.removeLink (fromOsPath packfile) - removeWhenExistsWith R.removeLink (fromOsPath (packIdxFile packfile)) + removeWhenExistsWith removeFile packfile + removeWhenExistsWith removeFile (packIdxFile packfile) return True {- Try to retrieve a set of missing objects, from the remotes of a @@ -264,7 +263,7 @@ explodePackedRefsFile r = do . fileLines' <$> catchDefaultIO "" (safeReadFile f) forM_ rs makeref - removeWhenExistsWith R.removeLink (fromOsPath f) + removeWhenExistsWith removeFile f where makeref (sha, ref) = do let gitd = localGitDir r @@ -286,7 +285,7 @@ parsePacked l = case words l of {- git-branch -d cannot be used to remove a branch that is directly - pointing to a corrupt commit. -} nukeBranchRef :: Branch -> Repo -> IO () -nukeBranchRef b r = removeWhenExistsWith R.removeLink $ fromOsPath $ +nukeBranchRef b r = removeWhenExistsWith removeFile $ localGitDir r toOsPath (fromRef' b) {- Finds the most recent commit to a branch that does not need any @@ -425,7 +424,7 @@ rewriteIndex r | otherwise = do (bad, good, cleanup) <- partitionIndex r unless (null bad) $ do - removeWhenExistsWith R.removeLink (fromOsPath (indexFile r)) + removeWhenExistsWith removeFile (indexFile r) UpdateIndex.streamUpdateIndex r =<< (catMaybes <$> mapM reinject good) void cleanup @@ -473,7 +472,7 @@ displayList items header preRepair :: Repo -> IO () preRepair g = do unlessM (validhead <$> catchDefaultIO "" (decodeBS <$> safeReadFile headfile)) $ do - removeWhenExistsWith R.removeLink (fromOsPath headfile) + removeWhenExistsWith removeFile headfile writeFile (fromOsPath headfile) "ref: refs/heads/master" explodePackedRefsFile g unless (repoIsLocalBare g) $ @@ -606,7 +605,7 @@ runRepair' removablebranch fsckresult forced referencerepo g = do else successfulfinish modifiedbranches corruptedindex = do - removeWhenExistsWith R.removeLink (fromOsPath (indexFile g)) + removeWhenExistsWith removeFile (indexFile g) -- The corrupted index can prevent fsck from finding other -- problems, so re-run repair. fsckresult' <- findBroken False False g diff --git a/Remote/Helper/Chunked.hs b/Remote/Helper/Chunked.hs index 6d6b619fd4..f248db7b73 100644 --- a/Remote/Helper/Chunked.hs +++ b/Remote/Helper/Chunked.hs @@ -420,10 +420,10 @@ writeRetrievedContent dest enc encc mh mp content miv = case (enc, mh, content) withBytes content $ \b -> decrypt cmd encc cipher (feedBytes b) $ readBytes write - liftIO $ removeWhenExistsWith R.removeLink (fromOsPath f) + liftIO $ removeWhenExistsWith removeFile f (Nothing, _, FileContent f) -> do withBytes content write - liftIO $ removeWhenExistsWith R.removeLink (fromOsPath f) + liftIO $ removeWhenExistsWith removeFile f (Nothing, _, ByteContent b) -> write b where write b = case mh of diff --git a/Upgrade/V7.hs b/Upgrade/V7.hs index d4b3e35461..caabe13d2f 100644 --- a/Upgrade/V7.hs +++ b/Upgrade/V7.hs @@ -40,7 +40,7 @@ upgrade automatic = do -- new database is not populated. It will be automatically -- populated from the git-annex branch the next time it is used. removeOldDb =<< fromRepo gitAnnexContentIdentifierDbDirOld - liftIO . removeWhenExistsWith (R.removeLink . fromOsPath) + liftIO . removeWhenExistsWith removeFile =<< fromRepo gitAnnexContentIdentifierLockOld -- The export databases are deleted here. The new databases @@ -50,9 +50,9 @@ upgrade automatic = do populateKeysDb removeOldDb =<< fromRepo gitAnnexKeysDbOld - liftIO . removeWhenExistsWith (R.removeLink . fromOsPath) + liftIO . removeWhenExistsWith removeFile =<< fromRepo gitAnnexKeysDbIndexCacheOld - liftIO . removeWhenExistsWith (R.removeLink . fromOsPath) + liftIO . removeWhenExistsWith removeFile =<< fromRepo gitAnnexKeysDbLockOld updateSmudgeFilter diff --git a/Utility/LockFile/PidLock.hs b/Utility/LockFile/PidLock.hs index ff49d9abfa..505196c718 100644 --- a/Utility/LockFile/PidLock.hs +++ b/Utility/LockFile/PidLock.hs @@ -158,12 +158,12 @@ tryLock lockfile = do hClose h let failedlock = do dropSideLock sidelock - removeWhenExistsWith removeLink tmp' + removeWhenExistsWith removeFile tmp return Nothing let tooklock st = return $ Just $ LockHandle abslockfile st sidelock linkToLock sidelock tmp' (fromOsPath abslockfile) >>= \case Just lckst -> do - removeWhenExistsWith removeLink tmp' + removeWhenExistsWith removeFile tmp tooklock lckst Nothing -> do v <- readPidLock abslockfile @@ -251,7 +251,7 @@ checkInsaneLustre dest = do _ -> do -- Try to clean up the extra copy we made -- that has the same name. Egads. - _ <- tryIO $ removeLink $ fromOsPath dest + _ <- tryIO $ removeFile dest return True -- | Waits as necessary to take a lock. @@ -295,7 +295,7 @@ dropLock (LockHandle lockfile _ sidelock) = do -- Drop side lock first, at which point the pid lock will be -- considered stale. dropSideLock sidelock - removeWhenExistsWith removeLink (fromOsPath lockfile) + removeWhenExistsWith removeFile lockfile dropLock ParentLocked = return () getLockStatus :: PidLockFile -> IO LockStatus diff --git a/Utility/Tmp.hs b/Utility/Tmp.hs index 8e0ca10755..b9aff8979a 100644 --- a/Utility/Tmp.hs +++ b/Utility/Tmp.hs @@ -19,12 +19,10 @@ module Utility.Tmp ( ) where import System.IO -import System.Directory import Control.Monad.IO.Class import System.IO.Error import Data.Char import qualified Data.ByteString as B -import qualified System.FilePath.ByteString as P import Utility.Exception import Utility.FileSystemEncoding @@ -32,6 +30,7 @@ import Utility.FileMode import qualified Utility.RawFilePath as R import qualified Utility.FileIO as F import Utility.OsPath +import Utility.SystemDirectory type Template = OsString @@ -58,14 +57,14 @@ openTmpFileIn dir template = F.openTempFile dir template viaTmp :: (MonadMask m, MonadIO m) => (OsPath -> v -> m ()) -> OsPath -> v -> m () viaTmp a file content = bracketIO setup cleanup use where - (dir, base) = P.splitFileName (fromOsPath file) - template = relatedTemplate (base <> ".tmp") + (dir, base) = splitFileName file + template = relatedTemplate (fromOsPath base <> ".tmp") setup = do - createDirectoryIfMissing True (fromRawFilePath dir) - openTmpFileIn (toOsPath dir) template + createDirectoryIfMissing True dir + openTmpFileIn dir template cleanup (tmpfile, h) = do _ <- tryIO $ hClose h - tryIO $ R.removeLink (fromOsPath tmpfile) + tryIO $ removeFile tmpfile use (tmpfile, h) = do let tmpfile' = fromOsPath tmpfile -- Make mode the same as if the file were created usually, @@ -83,8 +82,8 @@ viaTmp a file content = bracketIO setup cleanup use - (or in "." if there is none) then removes the file. -} withTmpFile :: (MonadIO m, MonadMask m) => Template -> (OsPath -> Handle -> m a) -> m a withTmpFile template a = do - tmpdir <- liftIO $ catchDefaultIO "." getTemporaryDirectory - withTmpFileIn (toOsPath (toRawFilePath tmpdir)) template a + tmpdir <- liftIO $ catchDefaultIO (literalOsPath ".") getTemporaryDirectory + withTmpFileIn tmpdir template a {- Runs an action with a tmp file located in the specified directory, - then removes the file. @@ -98,7 +97,7 @@ withTmpFileIn tmpdir template a = bracket create remove use create = liftIO $ openTmpFileIn tmpdir template remove (name, h) = liftIO $ do hClose h - tryIO $ R.removeLink (fromOsPath name) + tryIO $ removeFile name use (name, h) = a name h {- It's not safe to use a FilePath of an existing file as the template