Support special remotes that are configured with importtree=yes but without exporttree=yes

There was no particular reason not to support this, other than maybe a lack
of a use case. One use case would of course be a remote that you want to
avoid overwriting content on. A new use case is the idea of importing from
backups, eg borg, where exporting is not necessarily supported at all.

This commit was sponsored by Brock Spratlen on Patreon.
This commit is contained in:
Joey Hess 2020-12-10 13:17:40 -04:00
parent 38e0e2e471
commit 6a11b6fab8
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
2 changed files with 43 additions and 45 deletions

View file

@ -10,6 +10,8 @@ git-annex (8.20201128) UNRELEASED; urgency=medium
* Avoid spurious "verification of content failed" message when downloading * Avoid spurious "verification of content failed" message when downloading
content from a ssh or tor remote fails due to the remote no longer content from a ssh or tor remote fails due to the remote no longer
having a copy of the content. having a copy of the content.
* Support special remotes that are configured with importtree=yes but
without exporttree=yes.
-- Joey Hess <id@joeyh.name> Mon, 30 Nov 2020 12:55:49 -0400 -- Joey Hess <id@joeyh.name> Mon, 30 Nov 2020 12:55:49 -0400

View file

@ -97,42 +97,33 @@ adjustExportImportRemoteType rt = rt { setup = setup' }
) )
checkconfig exportSupported exportTree exportTreeField $ checkconfig exportSupported exportTree exportTreeField $
checkconfig importSupported importTree importTreeField $ checkconfig importSupported importTree importTreeField $
if importTree pc && not (exportTree pc) setup rt st mu cp c gc
then giveup "cannot enable importtree=yes without also enabling exporttree=yes"
else setup rt st mu cp c gc
-- | Adjust a remote to support exporttree=yes and importree=yes. -- | Adjust a remote to support exporttree=yes and/or importree=yes.
--
-- Note that all remotes with importree=yes also have exporttree=yes.
adjustExportImport :: Remote -> RemoteStateHandle -> Annex Remote adjustExportImport :: Remote -> RemoteStateHandle -> Annex Remote
adjustExportImport r rs = case getRemoteConfigValue exportTreeField (config r) of adjustExportImport rmt rs = do
Nothing -> return $ notexport r dbv <- prepdbv
Just True -> ifM (isExportSupported r) case (exportTree (config rmt), importTree (config rmt)) of
( do (True, True) -> isimport dbv =<< isexport dbv rmt
exportdbv <- prepexportdb (True, False) -> notimport =<< isexport dbv rmt
r' <- isexport exportdbv (False, True) -> notexport =<< isimport dbv rmt
if importTree (config r) (False, False) -> notimport =<< notexport rmt
then isimport r' exportdbv
else return r'
, return $ notexport r
)
Just False -> return $ notexport r
where where
notexport r' = notimport r' notexport r = return $ r
{ exportActions = exportUnsupported { exportActions = exportUnsupported
, remotetype = (remotetype r') , remotetype = (remotetype r)
{ exportSupported = exportUnsupported { exportSupported = exportUnsupported
} }
} }
notimport r' = r' notimport r = return $ r
{ importActions = importUnsupported { importActions = importUnsupported
, remotetype = (remotetype r') , remotetype = (remotetype r)
{ importSupported = importUnsupported { importSupported = importUnsupported
} }
} }
isimport r' exportdbv = do isimport dbv r = do
ciddbv <- prepciddb ciddbv <- prepciddb
let keycids k = do let keycids k = do
@ -141,27 +132,27 @@ adjustExportImport r rs = case getRemoteConfigValue exportTreeField (config r) o
let checkpresent k loc = let checkpresent k loc =
checkPresentExportWithContentIdentifier checkPresentExportWithContentIdentifier
(importActions r') (importActions r)
k loc k loc
=<< keycids k =<< keycids k
return $ r' return $ r
{ exportActions = (exportActions r') { exportActions = (exportActions r)
{ storeExport = \f k loc p -> do { storeExport = \f k loc p -> do
db <- getciddb ciddbv db <- getciddb ciddbv
exportdb <- getexportdb exportdbv exportdb <- getexportdb r dbv
oldks <- liftIO $ Export.getExportTreeKey exportdb loc oldks <- liftIO $ Export.getExportTreeKey exportdb loc
oldcids <- liftIO $ concat oldcids <- liftIO $ concat
<$> mapM (ContentIdentifier.getContentIdentifiers db rs) oldks <$> mapM (ContentIdentifier.getContentIdentifiers db rs) oldks
newcid <- storeExportWithContentIdentifier (importActions r') f k loc oldcids p newcid <- storeExportWithContentIdentifier (importActions r) f k loc oldcids p
withExclusiveLock gitAnnexContentIdentifierLock $ do withExclusiveLock gitAnnexContentIdentifierLock $ do
liftIO $ ContentIdentifier.recordContentIdentifier db rs newcid k liftIO $ ContentIdentifier.recordContentIdentifier db rs newcid k
liftIO $ ContentIdentifier.flushDbQueue db liftIO $ ContentIdentifier.flushDbQueue db
recordContentIdentifier rs newcid k recordContentIdentifier rs newcid k
, removeExport = \k loc -> , removeExport = \k loc ->
removeExportWithContentIdentifier (importActions r') k loc removeExportWithContentIdentifier (importActions r) k loc
=<< keycids k =<< keycids k
, removeExportDirectory = removeExportDirectoryWhenEmpty (importActions r') , removeExportDirectory = removeExportDirectoryWhenEmpty (importActions r)
-- renameExport is optional, and the -- renameExport is optional, and the
-- remote's implementation may -- remote's implementation may
-- lose modifications to the file -- lose modifications to the file
@ -170,16 +161,21 @@ adjustExportImport r rs = case getRemoteConfigValue exportTreeField (config r) o
, renameExport = \_ _ _ -> return Nothing , renameExport = \_ _ _ -> return Nothing
, checkPresentExport = checkpresent , checkPresentExport = checkpresent
} }
, checkPresent = if appendonly r' , checkPresent = if appendonly r
then checkPresent r' then checkPresent r
else \k -> anyM (checkpresent k) else \k -> anyM (checkpresent k)
=<< getexportlocs exportdbv k =<< getexportlocs r dbv k
, getInfo = do , getInfo = do
is <- getInfo r' is <- getInfo r
return (is++[("import", "yes")]) return (is++[("import", "yes")])
} }
isexport dbv r = ifM (isExportSupported r)
( isexport' dbv r
, notexport r
)
isexport dbv = return $ r isexport' dbv r = return $ r
-- Storing a key on an export could be implemented, -- Storing a key on an export could be implemented,
-- but it would perform unncessary work -- but it would perform unncessary work
-- when another repository has already stored the -- when another repository has already stored the
@ -197,7 +193,7 @@ adjustExportImport r rs = case getRemoteConfigValue exportTreeField (config r) o
-- so don't need to use retrieveExport. However, -- so don't need to use retrieveExport. However,
-- fall back to it if retrieveKeyFile fails. -- fall back to it if retrieveKeyFile fails.
, retrieveKeyFile = \k af dest p -> , retrieveKeyFile = \k af dest p ->
let retrieveexport = retrieveKeyFileFromExport dbv k af dest p let retrieveexport = retrieveKeyFileFromExport r dbv k af dest p
in if appendonly r in if appendonly r
then retrieveKeyFile r k af dest p then retrieveKeyFile r k af dest p
`catchNonAsync` const retrieveexport `catchNonAsync` const retrieveexport
@ -230,7 +226,7 @@ adjustExportImport r rs = case getRemoteConfigValue exportTreeField (config r) o
, checkPresent = if appendonly r , checkPresent = if appendonly r
then checkPresent r then checkPresent r
else \k -> anyM (checkPresentExport (exportActions r) k) else \k -> anyM (checkPresentExport (exportActions r) k)
=<< getexportlocs dbv k =<< getexportlocs r dbv k
-- checkPresent from an export is more expensive -- checkPresent from an export is more expensive
-- than otherwise, so not cheap. Also, this -- than otherwise, so not cheap. Also, this
-- avoids things that look at checkPresentCheap and -- avoids things that look at checkPresentCheap and
@ -251,7 +247,7 @@ adjustExportImport r rs = case getRemoteConfigValue exportTreeField (config r) o
dbtv <- liftIO newEmptyTMVarIO dbtv <- liftIO newEmptyTMVarIO
return (dbtv, lcklckv) return (dbtv, lcklckv)
prepexportdb = do prepdbv = do
lcklckv <- liftIO newEmptyTMVarIO lcklckv <- liftIO newEmptyTMVarIO
dbv <- liftIO newEmptyTMVarIO dbv <- liftIO newEmptyTMVarIO
exportinconflict <- liftIO $ newTVarIO False exportinconflict <- liftIO $ newTVarIO False
@ -281,14 +277,14 @@ adjustExportImport r rs = case getRemoteConfigValue exportTreeField (config r) o
-- After opening the database, check if the export log is -- After opening the database, check if the export log is
-- different than the database, and update the database, to notice -- different than the database, and update the database, to notice
-- when an export has been updated from another repository. -- when an export has been updated from another repository.
getexportdb (dbv, lcklckv, exportinconflict) = getexportdb r (dbv, lcklckv, exportinconflict) =
liftIO (atomically (tryReadTMVar dbv)) >>= \case liftIO (atomically (tryReadTMVar dbv)) >>= \case
Just db -> return db Just db -> return db
-- let only one thread take the lock -- let only one thread take the lock
Nothing -> ifM (liftIO $ atomically $ tryPutTMVar lcklckv ()) Nothing -> ifM (liftIO $ atomically $ tryPutTMVar lcklckv ())
( do ( do
db <- Export.openDb (uuid r) db <- Export.openDb (uuid r)
updateexportdb db exportinconflict updateexportdb db exportinconflict r
liftIO $ atomically $ putTMVar dbv db liftIO $ atomically $ putTMVar dbv db
return db return db
-- loser waits for winner to open the db and -- loser waits for winner to open the db and
@ -298,7 +294,7 @@ adjustExportImport r rs = case getRemoteConfigValue exportTreeField (config r) o
getexportinconflict (_, _, v) = v getexportinconflict (_, _, v) = v
updateexportdb db exportinconflict = updateexportdb db exportinconflict r =
Export.updateExportTreeFromLog db >>= \case Export.updateExportTreeFromLog db >>= \case
Export.ExportUpdateSuccess -> return () Export.ExportUpdateSuccess -> return ()
Export.ExportUpdateConflict -> do Export.ExportUpdateConflict -> do
@ -306,13 +302,13 @@ adjustExportImport r rs = case getRemoteConfigValue exportTreeField (config r) o
liftIO $ atomically $ liftIO $ atomically $
writeTVar exportinconflict True writeTVar exportinconflict True
getexportlocs dbv k = do getexportlocs r dbv k = do
db <- getexportdb dbv db <- getexportdb r dbv
liftIO $ Export.getExportTree db k liftIO $ Export.getExportTree db k
retrieveKeyFileFromExport dbv k _af dest p = ifM (isVerifiable k) retrieveKeyFileFromExport r dbv k _af dest p = ifM (isVerifiable k)
( do ( do
locs <- getexportlocs dbv k locs <- getexportlocs r dbv k
case locs of case locs of
[] -> ifM (liftIO $ atomically $ readTVar $ getexportinconflict dbv) [] -> ifM (liftIO $ atomically $ readTVar $ getexportinconflict dbv)
( giveup "unknown export location, likely due to the export conflict" ( giveup "unknown export location, likely due to the export conflict"