change retrieveExportWithContentIdentifier to take a list of ContentIdentifier
This partly fixes an issue where there are duplicate files in the special remote, and the first file gets swapped with another duplicate, or deleted. The swap case is fixed by this, the deleted case will need other changes. This makes retrieveExportWithContentIdentifier take a list of allowed ContentIdentifier, same as storeExportWithContentIdentifier, removeExportWithContentIdentifier, and checkPresentExportWithContentIdentifier. Of the special remotes that support importtree, borg is a special case and does not use content identifiers, S3 I assume can't get mixed up like this, directory certainly has the problem, and adb also appears to have had the problem. Sponsored-by: Graham Spencer on Patreon
This commit is contained in:
parent
3adf1f24e2
commit
0ffc59d341
7 changed files with 32 additions and 29 deletions
|
@ -600,7 +600,7 @@ importKeys remote importtreeconfig importcontent thirdpartypopulated importablec
|
||||||
let af = AssociatedFile (Just f)
|
let af = AssociatedFile (Just f)
|
||||||
let downloader p' tmpfile = do
|
let downloader p' tmpfile = do
|
||||||
_ <- Remote.retrieveExportWithContentIdentifier
|
_ <- Remote.retrieveExportWithContentIdentifier
|
||||||
ia loc cid (fromRawFilePath tmpfile)
|
ia loc [cid] (fromRawFilePath tmpfile)
|
||||||
(Left k)
|
(Left k)
|
||||||
(combineMeterUpdate p' p)
|
(combineMeterUpdate p' p)
|
||||||
ok <- moveAnnex k af tmpfile
|
ok <- moveAnnex k af tmpfile
|
||||||
|
@ -618,7 +618,7 @@ importKeys remote importtreeconfig importcontent thirdpartypopulated importablec
|
||||||
doimportsmall cidmap db loc cid sz p = do
|
doimportsmall cidmap db loc cid sz p = do
|
||||||
let downloader tmpfile = do
|
let downloader tmpfile = do
|
||||||
(k, _) <- Remote.retrieveExportWithContentIdentifier
|
(k, _) <- Remote.retrieveExportWithContentIdentifier
|
||||||
ia loc cid (fromRawFilePath tmpfile)
|
ia loc [cid] (fromRawFilePath tmpfile)
|
||||||
(Right (mkkey tmpfile))
|
(Right (mkkey tmpfile))
|
||||||
p
|
p
|
||||||
case keyGitSha k of
|
case keyGitSha k of
|
||||||
|
@ -641,7 +641,7 @@ importKeys remote importtreeconfig importcontent thirdpartypopulated importablec
|
||||||
let af = AssociatedFile (Just f)
|
let af = AssociatedFile (Just f)
|
||||||
let downloader tmpfile p = do
|
let downloader tmpfile p = do
|
||||||
(k, _) <- Remote.retrieveExportWithContentIdentifier
|
(k, _) <- Remote.retrieveExportWithContentIdentifier
|
||||||
ia loc cid (fromRawFilePath tmpfile)
|
ia loc [cid] (fromRawFilePath tmpfile)
|
||||||
(Right (mkkey tmpfile))
|
(Right (mkkey tmpfile))
|
||||||
p
|
p
|
||||||
case keyGitSha k of
|
case keyGitSha k of
|
||||||
|
|
|
@ -360,8 +360,8 @@ listImportableContentsM serial adir c = adbfind >>= \case
|
||||||
-- connection is resonably fast, it's probably as good as
|
-- connection is resonably fast, it's probably as good as
|
||||||
-- git's handling of similar situations with files being modified while
|
-- git's handling of similar situations with files being modified while
|
||||||
-- it's updating the working tree for a merge.
|
-- it's updating the working tree for a merge.
|
||||||
retrieveExportWithContentIdentifierM :: AndroidSerial -> AndroidPath -> ExportLocation -> ContentIdentifier -> FilePath -> Either Key (Annex Key) -> MeterUpdate -> Annex (Key, Verification)
|
retrieveExportWithContentIdentifierM :: AndroidSerial -> AndroidPath -> ExportLocation -> [ContentIdentifier] -> FilePath -> Either Key (Annex Key) -> MeterUpdate -> Annex (Key, Verification)
|
||||||
retrieveExportWithContentIdentifierM serial adir loc cid dest gk _p = do
|
retrieveExportWithContentIdentifierM serial adir loc cids dest gk _p = do
|
||||||
case gk of
|
case gk of
|
||||||
Right mkkey -> do
|
Right mkkey -> do
|
||||||
go
|
go
|
||||||
|
@ -374,9 +374,10 @@ retrieveExportWithContentIdentifierM serial adir loc cid dest gk _p = do
|
||||||
where
|
where
|
||||||
go = do
|
go = do
|
||||||
retrieve' serial src dest
|
retrieve' serial src dest
|
||||||
currcid <- getExportContentIdentifier serial adir loc
|
getExportContentIdentifier serial adir loc >>= \case
|
||||||
when (currcid /= Right (Just cid)) $
|
Right (Just currcid)
|
||||||
giveup "the file on the android device has changed"
|
| any (currcid ==) cids -> return ()
|
||||||
|
_ -> giveup "the file on the android device has changed"
|
||||||
src = androidExportLocation adir loc
|
src = androidExportLocation adir loc
|
||||||
|
|
||||||
storeExportWithContentIdentifierM :: AndroidSerial -> AndroidPath -> FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex ContentIdentifier
|
storeExportWithContentIdentifierM :: AndroidSerial -> AndroidPath -> FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex ContentIdentifier
|
||||||
|
|
|
@ -371,7 +371,7 @@ checkPresentExportWithContentIdentifierM borgrepo _ loc _ = prompt $ liftIO $ do
|
||||||
, giveup $ "Unable to access borg repository " ++ locBorgRepo borgrepo
|
, giveup $ "Unable to access borg repository " ++ locBorgRepo borgrepo
|
||||||
)
|
)
|
||||||
|
|
||||||
retrieveExportWithContentIdentifierM :: BorgRepo -> ImportLocation -> ContentIdentifier -> FilePath -> Either Key (Annex Key) -> MeterUpdate -> Annex (Key, Verification)
|
retrieveExportWithContentIdentifierM :: BorgRepo -> ImportLocation -> [ContentIdentifier] -> FilePath -> Either Key (Annex Key) -> MeterUpdate -> Annex (Key, Verification)
|
||||||
retrieveExportWithContentIdentifierM borgrepo loc _ dest gk _ = do
|
retrieveExportWithContentIdentifierM borgrepo loc _ dest gk _ = do
|
||||||
showOutput
|
showOutput
|
||||||
case gk of
|
case gk of
|
||||||
|
|
|
@ -394,12 +394,12 @@ mkContentIdentifier (IgnoreInodes ii) f st =
|
||||||
-- versions of git-annex ignored inodes by default, treat two content
|
-- versions of git-annex ignored inodes by default, treat two content
|
||||||
-- idenfiers as the same if they differ only by one having the inode
|
-- idenfiers as the same if they differ only by one having the inode
|
||||||
-- ignored.
|
-- ignored.
|
||||||
guardSameContentIdentifiers :: a -> ContentIdentifier -> Maybe ContentIdentifier -> a
|
guardSameContentIdentifiers :: a -> [ContentIdentifier] -> Maybe ContentIdentifier -> a
|
||||||
guardSameContentIdentifiers _ _ Nothing = giveup "file not found"
|
guardSameContentIdentifiers _ _ Nothing = giveup "file not found"
|
||||||
guardSameContentIdentifiers cont old (Just new)
|
guardSameContentIdentifiers cont olds (Just new)
|
||||||
| new == old = cont
|
| any (new ==) olds = cont
|
||||||
| ignoreinode new == old = cont
|
| any (ignoreinode new ==) olds = cont
|
||||||
| new == ignoreinode old = cont
|
| any (\old -> new == ignoreinode old) olds = cont
|
||||||
| otherwise = giveup "file content has changed"
|
| otherwise = giveup "file content has changed"
|
||||||
where
|
where
|
||||||
ignoreinode cid@(ContentIdentifier b) =
|
ignoreinode cid@(ContentIdentifier b) =
|
||||||
|
@ -417,7 +417,7 @@ importKeyM ii dir loc cid sz p = do
|
||||||
{ keySize = keySize kd <|> Just sz }
|
{ keySize = keySize kd <|> Just sz }
|
||||||
currcid <- liftIO $ mkContentIdentifier ii absf
|
currcid <- liftIO $ mkContentIdentifier ii absf
|
||||||
=<< R.getSymbolicLinkStatus absf
|
=<< R.getSymbolicLinkStatus absf
|
||||||
guardSameContentIdentifiers (return (Just k)) cid currcid
|
guardSameContentIdentifiers (return (Just k)) [cid] currcid
|
||||||
where
|
where
|
||||||
f = fromExportLocation loc
|
f = fromExportLocation loc
|
||||||
absf = dir P.</> f
|
absf = dir P.</> f
|
||||||
|
@ -427,8 +427,8 @@ importKeyM ii dir loc cid sz p = do
|
||||||
, inodeCache = Nothing
|
, inodeCache = Nothing
|
||||||
}
|
}
|
||||||
|
|
||||||
retrieveExportWithContentIdentifierM :: IgnoreInodes -> RawFilePath -> CopyCoWTried -> ExportLocation -> ContentIdentifier -> FilePath -> Either Key (Annex Key) -> MeterUpdate -> Annex (Key, Verification)
|
retrieveExportWithContentIdentifierM :: IgnoreInodes -> RawFilePath -> CopyCoWTried -> ExportLocation -> [ContentIdentifier] -> FilePath -> Either Key (Annex Key) -> MeterUpdate -> Annex (Key, Verification)
|
||||||
retrieveExportWithContentIdentifierM ii dir cow loc cid dest gk p =
|
retrieveExportWithContentIdentifierM ii dir cow loc cids dest gk p =
|
||||||
case gk of
|
case gk of
|
||||||
Right mkkey -> do
|
Right mkkey -> do
|
||||||
go Nothing
|
go Nothing
|
||||||
|
@ -474,7 +474,7 @@ retrieveExportWithContentIdentifierM ii dir cow loc cid dest gk p =
|
||||||
|
|
||||||
-- Check before copy, to avoid expensive copy of wrong file
|
-- Check before copy, to avoid expensive copy of wrong file
|
||||||
-- content.
|
-- content.
|
||||||
precheck cont = guardSameContentIdentifiers cont cid
|
precheck cont = guardSameContentIdentifiers cont cids
|
||||||
=<< liftIO . mkContentIdentifier ii f
|
=<< liftIO . mkContentIdentifier ii f
|
||||||
=<< liftIO (R.getSymbolicLinkStatus f)
|
=<< liftIO (R.getSymbolicLinkStatus f)
|
||||||
|
|
||||||
|
@ -502,7 +502,7 @@ retrieveExportWithContentIdentifierM ii dir cow loc cid dest gk p =
|
||||||
#else
|
#else
|
||||||
=<< R.getSymbolicLinkStatus f
|
=<< R.getSymbolicLinkStatus f
|
||||||
#endif
|
#endif
|
||||||
guardSameContentIdentifiers cont cid currcid
|
guardSameContentIdentifiers cont cids currcid
|
||||||
|
|
||||||
-- When copy-on-write was done, cannot check the handle that was
|
-- When copy-on-write was done, cannot check the handle that was
|
||||||
-- copied from, but such a copy should run very fast, so
|
-- copied from, but such a copy should run very fast, so
|
||||||
|
@ -512,7 +512,7 @@ retrieveExportWithContentIdentifierM ii dir cow loc cid dest gk p =
|
||||||
postcheckcow cont = do
|
postcheckcow cont = do
|
||||||
currcid <- liftIO $ mkContentIdentifier ii f
|
currcid <- liftIO $ mkContentIdentifier ii f
|
||||||
=<< R.getSymbolicLinkStatus f
|
=<< R.getSymbolicLinkStatus f
|
||||||
guardSameContentIdentifiers cont cid currcid
|
guardSameContentIdentifiers cont cids currcid
|
||||||
|
|
||||||
storeExportWithContentIdentifierM :: IgnoreInodes -> RawFilePath -> CopyCoWTried -> FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex ContentIdentifier
|
storeExportWithContentIdentifierM :: IgnoreInodes -> RawFilePath -> CopyCoWTried -> FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex ContentIdentifier
|
||||||
storeExportWithContentIdentifierM ii dir cow src _k loc overwritablecids p = do
|
storeExportWithContentIdentifierM ii dir cow src _k loc overwritablecids p = do
|
||||||
|
|
|
@ -359,14 +359,15 @@ adjustExportImport' isexport isimport r rs = do
|
||||||
, giveup $ "exported content cannot be verified due to using the " ++ decodeBS (formatKeyVariety (fromKey keyVariety k)) ++ " backend"
|
, giveup $ "exported content cannot be verified due to using the " ++ decodeBS (formatKeyVariety (fromKey keyVariety k)) ++ " backend"
|
||||||
)
|
)
|
||||||
|
|
||||||
retrieveKeyFileFromImport dbv ciddbv k af dest p =
|
retrieveKeyFileFromImport dbv ciddbv k af dest p = do
|
||||||
getkeycids ciddbv k >>= \case
|
cids <- getkeycids ciddbv k
|
||||||
(cid:_) -> do
|
if not (null cids)
|
||||||
|
then do
|
||||||
l <- getfirstexportloc dbv k
|
l <- getfirstexportloc dbv k
|
||||||
snd <$> retrieveExportWithContentIdentifier (importActions r) l cid dest (Left k) p
|
snd <$> retrieveExportWithContentIdentifier (importActions r) l cids dest (Left k) p
|
||||||
-- In case a content identifier is somehow missing,
|
-- In case a content identifier is somehow missing,
|
||||||
-- try this instead.
|
-- try this instead.
|
||||||
[] -> if isexport
|
else if isexport
|
||||||
then retrieveKeyFileFromExport dbv k af dest p
|
then retrieveKeyFileFromExport dbv k af dest p
|
||||||
else giveup "no content identifier is recorded, unable to retrieve"
|
else giveup "no content identifier is recorded, unable to retrieve"
|
||||||
|
|
||||||
|
|
|
@ -649,8 +649,8 @@ mkImportableContentsVersioned info = build . groupfiles
|
||||||
| otherwise =
|
| otherwise =
|
||||||
i : removemostrecent mtime rest
|
i : removemostrecent mtime rest
|
||||||
|
|
||||||
retrieveExportWithContentIdentifierS3 :: S3HandleVar -> Remote -> RemoteStateHandle -> S3Info -> ExportLocation -> ContentIdentifier -> FilePath -> Either Key (Annex Key) -> MeterUpdate -> Annex (Key, Verification)
|
retrieveExportWithContentIdentifierS3 :: S3HandleVar -> Remote -> RemoteStateHandle -> S3Info -> ExportLocation -> [ContentIdentifier] -> FilePath -> Either Key (Annex Key) -> MeterUpdate -> Annex (Key, Verification)
|
||||||
retrieveExportWithContentIdentifierS3 hv r rs info loc cid dest gk p =
|
retrieveExportWithContentIdentifierS3 hv r rs info loc (cid:_) dest gk p =
|
||||||
case gk of
|
case gk of
|
||||||
Right _mkkey -> do
|
Right _mkkey -> do
|
||||||
k <- go Nothing
|
k <- go Nothing
|
||||||
|
@ -675,6 +675,7 @@ retrieveExportWithContentIdentifierS3 hv r rs info loc cid dest gk p =
|
||||||
return k
|
return k
|
||||||
Nothing -> giveup $ needS3Creds (uuid r)
|
Nothing -> giveup $ needS3Creds (uuid r)
|
||||||
o = T.pack $ bucketExportLocation info loc
|
o = T.pack $ bucketExportLocation info loc
|
||||||
|
retrieveExportWithContentIdentifierS3 _ _ _ _ _ [] _ _ _ = giveup "missing content identifier"
|
||||||
|
|
||||||
{- Catch exception getObject returns when a precondition is not met,
|
{- Catch exception getObject returns when a precondition is not met,
|
||||||
- and replace with a more understandable message for the user. -}
|
- and replace with a more understandable message for the user. -}
|
||||||
|
|
|
@ -334,7 +334,7 @@ data ImportActions a = ImportActions
|
||||||
-- Throws exception on failure to access the remote.
|
-- Throws exception on failure to access the remote.
|
||||||
, importKey :: Maybe (ImportLocation -> ContentIdentifier -> ByteSize -> MeterUpdate -> a (Maybe Key))
|
, importKey :: Maybe (ImportLocation -> ContentIdentifier -> ByteSize -> MeterUpdate -> a (Maybe Key))
|
||||||
-- Retrieves a file from the remote. Ensures that the file
|
-- Retrieves a file from the remote. Ensures that the file
|
||||||
-- it retrieves has the requested ContentIdentifier.
|
-- it retrieves has one of the requested ContentIdentifiers.
|
||||||
--
|
--
|
||||||
-- This has to be used rather than retrieveExport
|
-- This has to be used rather than retrieveExport
|
||||||
-- when a special remote supports imports, since files on such a
|
-- when a special remote supports imports, since files on such a
|
||||||
|
@ -343,7 +343,7 @@ data ImportActions a = ImportActions
|
||||||
-- Throws exception on failure.
|
-- Throws exception on failure.
|
||||||
, retrieveExportWithContentIdentifier
|
, retrieveExportWithContentIdentifier
|
||||||
:: ExportLocation
|
:: ExportLocation
|
||||||
-> ContentIdentifier
|
-> [ContentIdentifier]
|
||||||
-- file to write content to
|
-- file to write content to
|
||||||
-> FilePath
|
-> FilePath
|
||||||
-- Either the key, or when it's not yet known, a callback
|
-- Either the key, or when it's not yet known, a callback
|
||||||
|
|
Loading…
Add table
Reference in a new issue