fix false positive from checkPresentExportWithContentIdentifierM when file does not exist
This commit is contained in:
parent
5767b1b00d
commit
b23c301820
1 changed files with 12 additions and 7 deletions
|
@ -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
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue