fix test suite

14683da9eb 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
This commit is contained in:
Joey Hess 2021-08-02 13:59:23 -04:00
parent 86bd9ac186
commit 6111958440
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
2 changed files with 10 additions and 4 deletions

View file

@ -374,6 +374,7 @@ checkSecureHashes' key = checkSecureHashes key >>= \case
return False return False
data LinkAnnexResult = LinkAnnexOk | LinkAnnexFailed | LinkAnnexNoop data LinkAnnexResult = LinkAnnexOk | LinkAnnexFailed | LinkAnnexNoop
deriving (Eq)
{- Populates the annex object file by hard linking or copying a source {- Populates the annex object file by hard linking or copying a source
- file to it. -} - file to it. -}
@ -396,7 +397,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) $ \tmp -> replaceFile' (const noop) (fromRawFilePath dest) (== LinkAnnexOk) $ \tmp ->
linkFromAnnex' key (toRawFilePath tmp) destmode linkFromAnnex' key (toRawFilePath 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. -}

View file

@ -1,6 +1,6 @@
{- git-annex file replacing {- git-annex file replacing
- -
- Copyright 2013-2020 Joey Hess <id@joeyh.name> - Copyright 2013-2021 Joey Hess <id@joeyh.name>
- -
- Licensed under the GNU AGPL version 3 or higher. - Licensed under the GNU AGPL version 3 or higher.
-} -}
@ -12,6 +12,7 @@ module Annex.ReplaceFile (
replaceGitDirFile, replaceGitDirFile,
replaceWorkTreeFile, replaceWorkTreeFile,
replaceFile, replaceFile,
replaceFile',
) where ) where
import Annex.Common import Annex.Common
@ -54,7 +55,10 @@ replaceWorkTreeFile = replaceFile createWorkTreeDirectory
- fails, and can create any parent directory structure needed. - fails, and can create any parent directory structure needed.
-} -}
replaceFile :: (RawFilePath -> Annex ()) -> FilePath -> (FilePath -> Annex a) -> Annex a 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 let othertmpdir' = fromRawFilePath othertmpdir
#ifndef mingw32_HOST_OS #ifndef mingw32_HOST_OS
-- Use part of the filename as the template for the temp -- 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 withTmpDirIn othertmpdir' basetmp $ \tmpdir -> do
let tmpfile = tmpdir </> basetmp let tmpfile = tmpdir </> basetmp
r <- action tmpfile r <- action tmpfile
replaceFileFrom tmpfile file createdirectory when (checkres r) $
replaceFileFrom tmpfile file createdirectory
return r return r
replaceFileFrom :: FilePath -> FilePath -> (RawFilePath -> Annex ()) -> Annex () replaceFileFrom :: FilePath -> FilePath -> (RawFilePath -> Annex ()) -> Annex ()