replace removeLink with removeFile
removeFile calls unlink so removes anything not a directory. So these are replaceable in order to convert to OsPath.
This commit is contained in:
parent
8af91a4c92
commit
5cc8d9d03b
9 changed files with 39 additions and 41 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
2
Creds.hs
2
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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue