From 6111958440353844a926b689ee3dcfe9c13a7c1c Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 2 Aug 2021 13:59:23 -0400 Subject: [PATCH] fix test suite 14683da9ebd629c3f77405b646d3f5661874f9d6 caused a test suite failure. When the content of a key is not present, a LinkAnnexFailed is returned, but replaceFile then tried to move the file into place, and since it was not written, that crashed. Sponsored-by: Boyd Stephen Smith Jr. on Patreon --- Annex/Content.hs | 3 ++- Annex/ReplaceFile.hs | 11 ++++++++--- 2 files changed, 10 insertions(+), 4 deletions(-) diff --git a/Annex/Content.hs b/Annex/Content.hs index 6e5b984677..4f05d61f67 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -374,6 +374,7 @@ checkSecureHashes' key = checkSecureHashes key >>= \case return False data LinkAnnexResult = LinkAnnexOk | LinkAnnexFailed | LinkAnnexNoop + deriving (Eq) {- Populates the annex object file by hard linking or copying a source - file to it. -} @@ -396,7 +397,7 @@ linkToAnnex key src srcic = ifM (checkSecureHashes' key) -} linkFromAnnex :: Key -> RawFilePath -> Maybe FileMode -> Annex LinkAnnexResult linkFromAnnex key dest destmode = - replaceFile (const noop) (fromRawFilePath dest) $ \tmp -> + replaceFile' (const noop) (fromRawFilePath dest) (== LinkAnnexOk) $ \tmp -> linkFromAnnex' key (toRawFilePath tmp) destmode {- This is only safe to use when dest is not a worktree file. -} diff --git a/Annex/ReplaceFile.hs b/Annex/ReplaceFile.hs index ffe5287c90..04125fd7c3 100644 --- a/Annex/ReplaceFile.hs +++ b/Annex/ReplaceFile.hs @@ -1,6 +1,6 @@ {- git-annex file replacing - - - Copyright 2013-2020 Joey Hess + - Copyright 2013-2021 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -12,6 +12,7 @@ module Annex.ReplaceFile ( replaceGitDirFile, replaceWorkTreeFile, replaceFile, + replaceFile', ) where import Annex.Common @@ -54,7 +55,10 @@ replaceWorkTreeFile = replaceFile createWorkTreeDirectory - fails, and can create any parent directory structure needed. -} replaceFile :: (RawFilePath -> Annex ()) -> FilePath -> (FilePath -> Annex a) -> Annex a -replaceFile createdirectory file action = withOtherTmp $ \othertmpdir -> do +replaceFile createdirectory file action = replaceFile' createdirectory file (const True) action + +replaceFile' :: (RawFilePath -> Annex ()) -> FilePath -> (a -> Bool) -> (FilePath -> Annex a) -> Annex a +replaceFile' createdirectory file checkres action = withOtherTmp $ \othertmpdir -> do let othertmpdir' = fromRawFilePath othertmpdir #ifndef mingw32_HOST_OS -- Use part of the filename as the template for the temp @@ -70,7 +74,8 @@ replaceFile createdirectory file action = withOtherTmp $ \othertmpdir -> do withTmpDirIn othertmpdir' basetmp $ \tmpdir -> do let tmpfile = tmpdir basetmp r <- action tmpfile - replaceFileFrom tmpfile file createdirectory + when (checkres r) $ + replaceFileFrom tmpfile file createdirectory return r replaceFileFrom :: FilePath -> FilePath -> (RawFilePath -> Annex ()) -> Annex ()