fix false positive from checkPresentExportWithContentIdentifierM when file does not exist

This commit is contained in:
Joey Hess 2019-03-05 17:04:00 -04:00
parent 5767b1b00d
commit b23c301820
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38

View file

@ -402,7 +402,7 @@ storeExportWithContentIdentifierM dir src _k loc overwritablecids p =
liftIO (getFileStatus tmpf) >>= liftIO . mkContentIdentifier tmpf >>= \case liftIO (getFileStatus tmpf) >>= liftIO . mkContentIdentifier tmpf >>= \case
Nothing -> return Nothing Nothing -> return Nothing
Just newcid -> Just newcid ->
checkExportContent dir loc (newcid:overwritablecids) Nothing $ do checkExportContent dir loc (newcid:overwritablecids) Nothing $ const $ do
liftIO $ rename tmpf dest liftIO $ rename tmpf dest
return (Just newcid) return (Just newcid)
where where
@ -412,13 +412,18 @@ storeExportWithContentIdentifierM dir src _k loc overwritablecids p =
removeExportWithContentIdentifierM :: FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> Annex Bool removeExportWithContentIdentifierM :: FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> Annex Bool
removeExportWithContentIdentifierM dir k loc removeablecids = removeExportWithContentIdentifierM dir k loc removeablecids =
checkExportContent dir loc removeablecids False $ checkExportContent dir loc removeablecids False $ \case
removeExportM dir k loc DoesNotExist -> return True
KnownContentIdentifier -> removeExportM dir k loc
checkPresentExportWithContentIdentifierM :: FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> Annex Bool checkPresentExportWithContentIdentifierM :: FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> Annex Bool
checkPresentExportWithContentIdentifierM dir _k loc knowncids = checkPresentExportWithContentIdentifierM dir _k loc knowncids =
checkPresentGeneric' dir $ checkPresentGeneric' dir $
checkExportContent dir loc knowncids False (return True) checkExportContent dir loc knowncids False $ \case
DoesNotExist -> return False
KnownContentIdentifier -> return True
data CheckResult = DoesNotExist | KnownContentIdentifier
-- Checks if the content at an ExportLocation is in the knowncids, -- Checks if the content at an ExportLocation is in the knowncids,
-- and only runs the callback that modifies it if it's safe to do so. -- and only runs the callback that modifies it if it's safe to do so.
@ -435,19 +440,19 @@ checkPresentExportWithContentIdentifierM dir _k loc knowncids =
-- --
-- So, it suffices to check if the destination file's current -- So, it suffices to check if the destination file's current
-- content is known, and immediately run the callback. -- content is known, and immediately run the callback.
checkExportContent :: FilePath -> ExportLocation -> [ContentIdentifier] -> a -> Annex a -> Annex a checkExportContent :: FilePath -> ExportLocation -> [ContentIdentifier] -> a -> (CheckResult -> Annex a) -> Annex a
checkExportContent dir loc knowncids unsafe callback = checkExportContent dir loc knowncids unsafe callback =
tryWhenExists (liftIO $ getFileStatus dest) >>= \case tryWhenExists (liftIO $ getFileStatus dest) >>= \case
Just destst Just destst
| not (isRegularFile destst) -> return unsafe | not (isRegularFile destst) -> return unsafe
| otherwise -> catchDefaultIO Nothing (liftIO $ mkContentIdentifier dest destst) >>= \case | otherwise -> catchDefaultIO Nothing (liftIO $ mkContentIdentifier dest destst) >>= \case
Just destcid Just destcid
| destcid `elem` knowncids -> callback | destcid `elem` knowncids -> callback KnownContentIdentifier
-- dest exists with other content -- dest exists with other content
| otherwise -> return unsafe | otherwise -> return unsafe
-- should never happen -- should never happen
Nothing -> return unsafe Nothing -> return unsafe
-- dest does not exist -- dest does not exist
Nothing -> callback Nothing -> callback DoesNotExist
where where
dest = exportPath dir loc dest = exportPath dir loc