RawFilePath conversion for replaceFile

Sponsored-by: Joshua Antonishen
This commit is contained in:
Joey Hess 2025-01-22 13:37:26 -04:00
parent af3b9cbd36
commit 90cd3aad37
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
13 changed files with 28 additions and 29 deletions

View file

@ -236,8 +236,9 @@ resolveMerge' unstagedmap (Just us) them inoverlay u = do
| otherwise = pure f | otherwise = pure f
makesymlink key dest = do makesymlink key dest = do
l <- calcRepo $ gitAnnexLink (toRawFilePath dest) key let rdest = toRawFilePath dest
unless inoverlay $ replacewithsymlink dest l l <- calcRepo $ gitAnnexLink rdest key
unless inoverlay $ replacewithsymlink rdest l
dest' <- toRawFilePath <$> stagefile dest dest' <- toRawFilePath <$> stagefile dest
stageSymlink dest' =<< hashSymlink l stageSymlink dest' =<< hashSymlink l
@ -265,7 +266,7 @@ resolveMerge' unstagedmap (Just us) them inoverlay u = do
let replacefile isexecutable = case selectwant' (LsFiles.unmergedSha u) of let replacefile isexecutable = case selectwant' (LsFiles.unmergedSha u) of
Nothing -> noop Nothing -> noop
Just sha -> replaceWorkTreeFile item $ \tmp -> do Just sha -> replaceWorkTreeFile (toRawFilePath item) $ \tmp -> do
c <- catObject sha c <- catObject sha
liftIO $ L.writeFile (decodeBS tmp) c liftIO $ L.writeFile (decodeBS tmp) c
when isexecutable $ when isexecutable $
@ -280,7 +281,7 @@ resolveMerge' unstagedmap (Just us) them inoverlay u = do
Nothing -> noop Nothing -> noop
Just sha -> do Just sha -> do
link <- catSymLinkTarget sha link <- catSymLinkTarget sha
replacewithsymlink item link replacewithsymlink (toRawFilePath item) link
(Just TreeFile, Just TreeSymlink) -> replacefile False (Just TreeFile, Just TreeSymlink) -> replacefile False
(Just TreeExecutable, Just TreeSymlink) -> replacefile True (Just TreeExecutable, Just TreeSymlink) -> replacefile True
_ -> ifM (liftIO $ doesDirectoryExist item) _ -> ifM (liftIO $ doesDirectoryExist item)

View file

@ -581,7 +581,7 @@ linkToAnnex key src srcic = ifM (checkSecureHashes' key)
-} -}
linkFromAnnex :: Key -> RawFilePath -> Maybe FileMode -> Annex LinkAnnexResult linkFromAnnex :: Key -> RawFilePath -> Maybe FileMode -> Annex LinkAnnexResult
linkFromAnnex key dest destmode = linkFromAnnex key dest destmode =
replaceFile' (const noop) (fromRawFilePath dest) (== LinkAnnexOk) $ \tmp -> replaceFile' (const noop) dest (== LinkAnnexOk) $ \tmp ->
linkFromAnnex' key tmp destmode linkFromAnnex' key tmp destmode
{- This is only safe to use when dest is not a worktree file. -} {- This is only safe to use when dest is not a worktree file. -}
@ -1076,7 +1076,7 @@ writeContentRetentionTimestamp key rt t = do
modifyContentDirWhenExists lckfile $ bracket (lock lckfile) unlock $ \_ -> modifyContentDirWhenExists lckfile $ bracket (lock lckfile) unlock $ \_ ->
readContentRetentionTimestamp rt >>= \case readContentRetentionTimestamp rt >>= \case
Just ts | ts >= t -> return () Just ts | ts >= t -> return ()
_ -> replaceFile (const noop) (fromRawFilePath rt) $ \tmp -> _ -> replaceFile (const noop) rt $ \tmp ->
liftIO $ writeFile (fromRawFilePath tmp) $ show t liftIO $ writeFile (fromRawFilePath tmp) $ show t
where where
lock = takeExclusiveLock lock = takeExclusiveLock

View file

@ -34,10 +34,9 @@ populatePointerFile :: Restage -> Key -> RawFilePath -> RawFilePath -> Annex (Ma
populatePointerFile restage k obj f = go =<< liftIO (isPointerFile f) populatePointerFile restage k obj f = go =<< liftIO (isPointerFile f)
where where
go (Just k') | k == k' = do go (Just k') | k == k' = do
let f' = fromRawFilePath f
destmode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus f destmode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus f
liftIO $ removeWhenExistsWith R.removeLink f liftIO $ removeWhenExistsWith R.removeLink f
(ic, populated) <- replaceWorkTreeFile f' $ \tmp -> do (ic, populated) <- replaceWorkTreeFile f $ \tmp -> do
ok <- linkOrCopy k obj tmp destmode >>= \case ok <- linkOrCopy k obj tmp destmode >>= \case
Just _ -> thawContent tmp >> return True Just _ -> thawContent tmp >> return True
Nothing -> liftIO (writePointerFile tmp k destmode) >> return False Nothing -> liftIO (writePointerFile tmp k destmode) >> return False
@ -58,7 +57,7 @@ depopulatePointerFile key file = do
let mode = fmap fileMode st let mode = fmap fileMode st
secureErase file secureErase file
liftIO $ removeWhenExistsWith R.removeLink file liftIO $ removeWhenExistsWith R.removeLink file
ic <- replaceWorkTreeFile (fromRawFilePath file) $ \tmp -> do ic <- replaceWorkTreeFile file $ \tmp -> do
liftIO $ writePointerFile tmp key mode liftIO $ writePointerFile tmp key mode
#if ! defined(mingw32_HOST_OS) #if ! defined(mingw32_HOST_OS)
-- Don't advance mtime; this avoids unnecessary re-smudging -- Don't advance mtime; this avoids unnecessary re-smudging

View file

@ -309,7 +309,7 @@ restoreFile file key e = do
makeLink :: RawFilePath -> Key -> Maybe InodeCache -> Annex LinkTarget makeLink :: RawFilePath -> Key -> Maybe InodeCache -> Annex LinkTarget
makeLink file key mcache = flip catchNonAsync (restoreFile file key) $ do makeLink file key mcache = flip catchNonAsync (restoreFile file key) $ do
l <- calcRepo $ gitAnnexLink file key l <- calcRepo $ gitAnnexLink file key
replaceWorkTreeFile file' $ makeAnnexLink l replaceWorkTreeFile file $ makeAnnexLink l
-- touch symlink to have same time as the original file, -- touch symlink to have same time as the original file,
-- as provided in the InodeCache -- as provided in the InodeCache
@ -318,8 +318,6 @@ makeLink file key mcache = flip catchNonAsync (restoreFile file key) $ do
Nothing -> noop Nothing -> noop
return l return l
where
file' = fromRawFilePath file
{- Creates the symlink to the annexed content, and stages it in git. -} {- Creates the symlink to the annexed content, and stages it in git. -}
addSymlink :: RawFilePath -> Key -> Maybe InodeCache -> Annex () addSymlink :: RawFilePath -> Key -> Maybe InodeCache -> Annex ()

View file

@ -24,17 +24,17 @@ import Utility.Directory.Create
import qualified System.FilePath.ByteString as P import qualified System.FilePath.ByteString as P
{- replaceFile on a file located inside the gitAnnexDir. -} {- replaceFile on a file located inside the gitAnnexDir. -}
replaceGitAnnexDirFile :: FilePath -> (RawFilePath -> Annex a) -> Annex a replaceGitAnnexDirFile :: RawFilePath -> (RawFilePath -> Annex a) -> Annex a
replaceGitAnnexDirFile = replaceFile createAnnexDirectory replaceGitAnnexDirFile = replaceFile createAnnexDirectory
{- replaceFile on a file located inside the .git directory. -} {- replaceFile on a file located inside the .git directory. -}
replaceGitDirFile :: FilePath -> (RawFilePath -> Annex a) -> Annex a replaceGitDirFile :: RawFilePath -> (RawFilePath -> Annex a) -> Annex a
replaceGitDirFile = replaceFile $ \dir -> do replaceGitDirFile = replaceFile $ \dir -> do
top <- fromRepo localGitDir top <- fromRepo localGitDir
liftIO $ createDirectoryUnder [top] dir liftIO $ createDirectoryUnder [top] dir
{- replaceFile on a worktree file. -} {- replaceFile on a worktree file. -}
replaceWorkTreeFile :: FilePath -> (RawFilePath -> Annex a) -> Annex a replaceWorkTreeFile :: RawFilePath -> (RawFilePath -> Annex a) -> Annex a
replaceWorkTreeFile = replaceFile createWorkTreeDirectory replaceWorkTreeFile = replaceFile createWorkTreeDirectory
{- Replaces a possibly already existing file with a new version, {- Replaces a possibly already existing file with a new version,
@ -52,17 +52,17 @@ replaceWorkTreeFile = replaceFile createWorkTreeDirectory
- The createdirectory action is only run when moving the file into place - The createdirectory action is only run when moving the file into place
- fails, and can create any parent directory structure needed. - fails, and can create any parent directory structure needed.
-} -}
replaceFile :: (RawFilePath -> Annex ()) -> FilePath -> (RawFilePath -> Annex a) -> Annex a replaceFile :: (RawFilePath -> Annex ()) -> RawFilePath -> (RawFilePath -> Annex a) -> Annex a
replaceFile createdirectory file action = replaceFile' createdirectory file (const True) action replaceFile createdirectory file action = replaceFile' createdirectory file (const True) action
replaceFile' :: (RawFilePath -> Annex ()) -> FilePath -> (a -> Bool) -> (RawFilePath -> Annex a) -> Annex a replaceFile' :: (RawFilePath -> Annex ()) -> RawFilePath -> (a -> Bool) -> (RawFilePath -> Annex a) -> Annex a
replaceFile' createdirectory file checkres action = withOtherTmp $ \othertmpdir -> do replaceFile' createdirectory file checkres action = withOtherTmp $ \othertmpdir -> do
let basetmp = relatedTemplate' (toRawFilePath file) let basetmp = relatedTemplate' file
withTmpDirIn (fromRawFilePath othertmpdir) (toOsPath basetmp) $ \tmpdir -> do withTmpDirIn (fromRawFilePath othertmpdir) (toOsPath basetmp) $ \tmpdir -> do
let tmpfile = toRawFilePath tmpdir P.</> basetmp let tmpfile = toRawFilePath tmpdir P.</> basetmp
r <- action tmpfile r <- action tmpfile
when (checkres r) $ when (checkres r) $
replaceFileFrom tmpfile (toRawFilePath file) createdirectory replaceFileFrom tmpfile file createdirectory
return r return r
replaceFileFrom :: RawFilePath -> RawFilePath -> (RawFilePath -> Annex ()) -> Annex () replaceFileFrom :: RawFilePath -> RawFilePath -> (RawFilePath -> Annex ()) -> Annex ()

View file

@ -289,7 +289,7 @@ onAddSymlink' linktarget mk file filestatus = go mk
if linktarget == Just link if linktarget == Just link
then ensurestaged (Just link) =<< getDaemonStatus then ensurestaged (Just link) =<< getDaemonStatus
else do else do
liftAnnex $ replaceWorkTreeFile file $ liftAnnex $ replaceWorkTreeFile (toRawFilePath file) $
makeAnnexLink link makeAnnexLink link
addLink file link (Just key) addLink file link (Just key)
-- other symlink, not git-annex -- other symlink, not git-annex

View file

@ -72,7 +72,7 @@ start fixwhat si file key = do
breakHardLink :: RawFilePath -> Key -> RawFilePath -> CommandPerform breakHardLink :: RawFilePath -> Key -> RawFilePath -> CommandPerform
breakHardLink file key obj = do breakHardLink file key obj = do
replaceWorkTreeFile (fromRawFilePath file) $ \tmp -> do replaceWorkTreeFile file $ \tmp -> do
mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file
unlessM (checkedCopyFile key obj tmp mode) $ unlessM (checkedCopyFile key obj tmp mode) $
giveup "unable to break hard link" giveup "unable to break hard link"
@ -83,7 +83,7 @@ breakHardLink file key obj = do
makeHardLink :: RawFilePath -> Key -> CommandPerform makeHardLink :: RawFilePath -> Key -> CommandPerform
makeHardLink file key = do makeHardLink file key = do
replaceWorkTreeFile (fromRawFilePath file) $ \tmp -> do replaceWorkTreeFile file $ \tmp -> do
mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file
linkFromAnnex' key tmp mode >>= \case linkFromAnnex' key tmp mode >>= \case
LinkAnnexFailed -> giveup "unable to make hard link" LinkAnnexFailed -> giveup "unable to make hard link"
@ -97,7 +97,7 @@ fixSymlink file link = do
mtime <- liftIO $ catchMaybeIO $ Posix.modificationTimeHiRes mtime <- liftIO $ catchMaybeIO $ Posix.modificationTimeHiRes
<$> R.getSymbolicLinkStatus file <$> R.getSymbolicLinkStatus file
#endif #endif
replaceWorkTreeFile (fromRawFilePath file) $ \tmpfile -> do replaceWorkTreeFile file $ \tmpfile -> do
liftIO $ R.createSymbolicLink link tmpfile liftIO $ R.createSymbolicLink link tmpfile
#if ! defined(mingw32_HOST_OS) #if ! defined(mingw32_HOST_OS)
liftIO $ maybe noop (\t -> touch tmpfile t False) mtime liftIO $ maybe noop (\t -> touch tmpfile t False) mtime

View file

@ -418,7 +418,7 @@ verifyWorkTree key file = do
case mk of case mk of
Just k | k == key -> whenM (inAnnex key) $ do Just k | k == key -> whenM (inAnnex key) $ do
showNote "fixing worktree content" showNote "fixing worktree content"
replaceWorkTreeFile (fromRawFilePath file) $ \tmp -> do replaceWorkTreeFile file $ \tmp -> do
mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file
ifM (annexThin <$> Annex.getGitConfig) ifM (annexThin <$> Annex.getGitConfig)
( void $ linkFromAnnex' key tmp mode ( void $ linkFromAnnex' key tmp mode

View file

@ -78,7 +78,7 @@ perform file key = do
breakhardlink obj = whenM (catchBoolIO $ (> 1) . linkCount <$> liftIO (R.getFileStatus obj)) $ do breakhardlink obj = whenM (catchBoolIO $ (> 1) . linkCount <$> liftIO (R.getFileStatus obj)) $ do
mfc <- withTSDelta (liftIO . genInodeCache file) mfc <- withTSDelta (liftIO . genInodeCache file)
unlessM (sameInodeCache obj (maybeToList mfc)) $ do unlessM (sameInodeCache obj (maybeToList mfc)) $ do
modifyContentDir obj $ replaceGitAnnexDirFile (fromRawFilePath obj) $ \tmp -> do modifyContentDir obj $ replaceGitAnnexDirFile obj $ \tmp -> do
unlessM (checkedCopyFile key obj tmp Nothing) $ unlessM (checkedCopyFile key obj tmp Nothing) $
giveup "unable to lock file" giveup "unable to lock file"
Database.Keys.storeInodeCaches key [obj] Database.Keys.storeInodeCaches key [obj]

View file

@ -104,7 +104,7 @@ linkKey file oldkey newkey = ifM (isJust <$> isAnnexLink file)
st <- liftIO $ R.getFileStatus file st <- liftIO $ R.getFileStatus file
when (linkCount st > 1) $ do when (linkCount st > 1) $ do
freezeContent oldobj freezeContent oldobj
replaceWorkTreeFile (fromRawFilePath file) $ \tmp -> do replaceWorkTreeFile file $ \tmp -> do
unlessM (checkedCopyFile oldkey oldobj tmp Nothing) $ unlessM (checkedCopyFile oldkey oldobj tmp Nothing) $
giveup "can't lock old key" giveup "can't lock old key"
thawContent tmp thawContent tmp

View file

@ -51,7 +51,7 @@ start si file key = ifM (isJust <$> isAnnexLink file)
perform :: RawFilePath -> Key -> CommandPerform perform :: RawFilePath -> Key -> CommandPerform
perform dest key = do perform dest key = do
destmode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus dest destmode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus dest
destic <- replaceWorkTreeFile (fromRawFilePath dest) $ \tmp -> do destic <- replaceWorkTreeFile dest $ \tmp -> do
ifM (inAnnex key) ifM (inAnnex key)
( do ( do
r <- linkFromAnnex' key tmp destmode r <- linkFromAnnex' key tmp destmode

View file

@ -48,7 +48,7 @@ writeLogFile f c = createDirWhenNeeded f $ viaTmp writelog (toOsPath f) c
withLogHandle :: RawFilePath -> (Handle -> Annex a) -> Annex a withLogHandle :: RawFilePath -> (Handle -> Annex a) -> Annex a
withLogHandle f a = do withLogHandle f a = do
createAnnexDirectory (parentDir f) createAnnexDirectory (parentDir f)
replaceGitAnnexDirFile (fromRawFilePath f) $ \tmp -> replaceGitAnnexDirFile f $ \tmp ->
bracket (setup tmp) cleanup a bracket (setup tmp) cleanup a
where where
setup tmp = do setup tmp = do

View file

@ -19,7 +19,8 @@ status.
Utility.RawFilePath needing to be changed. Utility.RawFilePath needing to be changed.
* Utility.FileIO is used for most withFile and openFile, but not yet for * Utility.FileIO is used for most withFile and openFile, but not yet for
readFile, writeFile, and appendFile. Including versions of those from readFile, writeFile, and appendFile. Including versions of those from
bytestring. Also readFileStrict should be replaced with Utility.FileIO.readFile' bytestring. Also readFileStrict should be replaced with
Utility.FileIO.readFile'
Note that the String versions can do newline translation, which has to be Note that the String versions can do newline translation, which has to be
handled when converting to the Utility.FileIO ones. handled when converting to the Utility.FileIO ones.