mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

added checkPresentExportWithContentIdentifier

Browse source 
Ugh, don't like needing to add this, but I can't see a way around it.
This commit is contained in:
Joey Hess 2019-03-05 16:02:33 -04:00
parent 3c652e1499
commit 46d33e804a
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
5 changed files with 130 additions and 92 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

23
Remote/Directory.hs
View file

@ -82,6 +82,7 @@ gen r u c gc = do
, storeExportWithContentIdentifier = storeExportWithContentIdentifierM dir
, removeExportWithContentIdentifier = removeExportWithContentIdentifierM dir
, removeExportDirectoryWhenEmpty = Nothing
, checkPresentExportWithContentIdentifier = checkPresentExportWithContentIdentifierM dir
}
, whereisKey = Nothing
, remoteFsck = Nothing
@ -237,14 +238,17 @@ checkPresentM d (LegacyChunks _) k = Legacy.checkKey d locations k
checkPresentM d _ k = checkPresentGeneric d (locations d k)
checkPresentGeneric :: FilePath -> [FilePath] -> Annex Bool
checkPresentGeneric d ps = liftIO $
ifM (anyM doesFileExist ps)
( return True
, ifM (doesDirectoryExist d)
( return False
, giveup $ "directory " ++ d ++ " is not accessible"
)
checkPresentGeneric d ps = checkPresentGeneric' d $
liftIO $ anyM doesFileExist ps
checkPresentGeneric' :: FilePath -> Annex Bool -> Annex Bool
checkPresentGeneric' d check = ifM check
( return True
, ifM (liftIO $ doesDirectoryExist d)
( return False
, giveup $ "directory " ++ d ++ " is not accessible"
)
)
storeExportM :: FilePath -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex Bool
storeExportM d src _k loc p = liftIO $ catchBoolIO $ do
@ -411,6 +415,11 @@ removeExportWithContentIdentifierM dir k loc removeablecids =
checkExportContent dir loc removeablecids False $
removeExportM dir k loc
checkPresentExportWithContentIdentifierM :: FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> Annex Bool
checkPresentExportWithContentIdentifierM dir _k loc knowncids =
checkPresentGeneric' dir $
checkExportContent dir loc knowncids False (return True)
-- 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.
--

173
Remote/Helper/ExportImport.hs
View file

@ -61,6 +61,7 @@ instance HasImportUnsupported (ImportActions Annex) where
, storeExportWithContentIdentifier = \_ _ _ _ _ -> return Nothing
, removeExportWithContentIdentifier = \_ _ _ -> return False
, removeExportDirectoryWhenEmpty = Just $ \_ -> return False
, checkPresentExportWithContentIdentifier = \_ _ _ -> return False
}
exportIsSupported :: RemoteConfig -> RemoteGitConfig -> Annex Bool
@ -140,6 +141,13 @@ adjustExportImport r = case M.lookup "exporttree" (config r) of
liftIO $ concat
<$> mapM (ContentIdentifier.getContentIdentifiers db (uuid r')) ks
let checkpresent k loc = do
db <- getciddb ciddbv
checkPresentExportWithContentIdentifier
(importActions r')
k loc
=<< getknowncids db loc
return $ r'
{ exportActions = (exportActions r')
{ storeExport = \f k loc p -> do
@ -162,87 +170,86 @@ adjustExportImport r = case M.lookup "exporttree" (config r) of
-- (by eg copying and then deleting)
-- so don't use it
, renameExport = \_ _ _ -> return False
, checkPresentExport = checkpresent
}
, checkPresent = if appendonly r'
then checkPresent r'
else \k -> anyM (checkpresent k)
=<< getexportlocs exportdbv k
}
isexport dbv = do
-- Get export locations for a key.
let getexportlocs = \k -> do
db <- getexportdb dbv
liftIO $ Export.getExportTree db k
return $ r
-- Storing a key on an export could be implemented,
-- but it would perform unncessary work
-- when another repository has already stored the
-- key, and the local repository does not know
-- about it. To avoid unnecessary costs, don't do it.
{ storeKey = \_ _ _ -> do
warning "remote is configured with exporttree=yes; use `git-annex export` to store content on it"
return False
-- Keys can be retrieved using retrieveExport,
-- but since that retrieves from a path in the
-- remote that another writer could have replaced
-- with content not of the requested key,
-- the content has to be strongly verified.
--
-- appendonly remotes have a key/value store,
-- so don't need to use retrieveExport. However,
-- fall back to it if retrieveKeyFile fails.
, retrieveKeyFile = \k af dest p ->
let retrieveexport = retrieveKeyFileFromExport getexportlocs (getexportinconflict dbv) k af dest p
in if appendonly r
then do
ret@(ok, _v) <- retrieveKeyFile r k af dest p
if ok
then return ret
else retrieveexport
else retrieveexport
, retrieveKeyFileCheap = if appendonly r
then retrieveKeyFileCheap r
else \_ _ _ -> return False
-- Removing a key from an export would need to
-- change the tree in the export log to not include
-- the file. Otherwise, conflicts when removing
-- files would not be dealt with correctly.
-- There does not seem to be a good use case for
-- removing a key from an export in any case.
, removeKey = \_k -> do
warning "dropping content from an export is not supported; use `git annex export` to export a tree that lacks the files you want to remove"
return False
-- Can't lock content on exports, since they're
-- not key/value stores, and someone else could
-- change what's exported to a file at any time.
--
-- (except for appendonly remotes)
, lockContent = if appendonly r
then lockContent r
else Nothing
-- Check if any of the files a key was exported to
-- are present. This doesn't guarantee the export
-- contains the right content, which is why export
-- remotes are untrusted.
--
-- (but appendonly remotes work the same as any
-- non-export remote)
, checkPresent = if appendonly r
then checkPresent r
else \k -> anyM (checkPresentExport (exportActions r) k)
=<< getexportlocs k
-- checkPresent from an export is more expensive
-- than otherwise, so not cheap. Also, this
-- avoids things that look at checkPresentCheap and
-- silently skip non-present files from behaving
-- in confusing ways when there's an export
-- conflict.
, checkPresentCheap = False
, mkUnavailable = return Nothing
, getInfo = do
ts <- map fromRef . exportedTreeishes
<$> getExport (uuid r)
is <- getInfo r
return (is++[("export", "yes"), ("exportedtree", unwords ts)])
}
isexport dbv = return $ r
-- Storing a key on an export could be implemented,
-- but it would perform unncessary work
-- when another repository has already stored the
-- key, and the local repository does not know
-- about it. To avoid unnecessary costs, don't do it.
{ storeKey = \_ _ _ -> do
warning "remote is configured with exporttree=yes; use `git-annex export` to store content on it"
return False
-- Keys can be retrieved using retrieveExport,
-- but since that retrieves from a path in the
-- remote that another writer could have replaced
-- with content not of the requested key,
-- the content has to be strongly verified.
--
-- appendonly remotes have a key/value store,
-- so don't need to use retrieveExport. However,
-- fall back to it if retrieveKeyFile fails.
, retrieveKeyFile = \k af dest p ->
let retrieveexport = retrieveKeyFileFromExport dbv k af dest p
in if appendonly r
then do
ret@(ok, _v) <- retrieveKeyFile r k af dest p
if ok
then return ret
else retrieveexport
else retrieveexport
, retrieveKeyFileCheap = if appendonly r
then retrieveKeyFileCheap r
else \_ _ _ -> return False
-- Removing a key from an export would need to
-- change the tree in the export log to not include
-- the file. Otherwise, conflicts when removing
-- files would not be dealt with correctly.
-- There does not seem to be a good use case for
-- removing a key from an export in any case.
, removeKey = \_k -> do
warning "dropping content from an export is not supported; use `git annex export` to export a tree that lacks the files you want to remove"
return False
-- Can't lock content on exports, since they're
-- not key/value stores, and someone else could
-- change what's exported to a file at any time.
--
-- (except for appendonly remotes)
, lockContent = if appendonly r
then lockContent r
else Nothing
-- Check if any of the files a key was exported to
-- are present. This doesn't guarantee the export
-- contains the right content, which is why export
-- remotes are untrusted.
--
-- (but appendonly remotes work the same as any
-- non-export remote)
, checkPresent = if appendonly r
then checkPresent r
else \k -> anyM (checkPresentExport (exportActions r) k)
=<< getexportlocs dbv k
-- checkPresent from an export is more expensive
-- than otherwise, so not cheap. Also, this
-- avoids things that look at checkPresentCheap and
-- silently skip non-present files from behaving
-- in confusing ways when there's an export
-- conflict.
, checkPresentCheap = False
, mkUnavailable = return Nothing
, getInfo = do
ts <- map fromRef . exportedTreeishes
<$> getExport (uuid r)
is <- getInfo r
return (is++[("export", "yes"), ("exportedtree", unwords ts)])
}
prepciddb = do
lcklckv <- liftIO newEmptyTMVarIO
@ -300,14 +307,18 @@ adjustExportImport r = case M.lookup "exporttree" (config r) of
warnExportConflict r
liftIO $ atomically $
writeTVar exportinconflict True
getexportlocs dbv k = do
db <- getexportdb dbv
liftIO $ Export.getExportTree db k
retrieveKeyFileFromExport getexportlocs exportinconflict k _af dest p = unVerified $
retrieveKeyFileFromExport dbv k _af dest p = unVerified $
if maybe False (isJust . verifyKeyContent) (maybeLookupBackendVariety (keyVariety k))
then do
locs <- getexportlocs k
locs <- getexportlocs dbv k
case locs of
[] -> do
ifM (liftIO $ atomically $ readTVar exportinconflict)
ifM (liftIO $ atomically $ readTVar $ getexportinconflict dbv)
( warning "unknown export location, likely due to the export conflict"
, warning "unknown export location"
)

8
Types/Remote.hs
View file

@ -312,4 +312,12 @@ data ImportActions a = ImportActions
--
-- If the directory is not empty, it should succeed.
, removeExportDirectoryWhenEmpty :: Maybe (ExportDirectory -> a Bool)
-- Checks if the specified ContentIdentifier is exported to the
-- remote at the specified ExportLocation.
-- Throws an exception if the remote cannot be accessed.
, checkPresentExportWithContentIdentifier
:: Key
-> ExportLocation
-> [ContentIdentifier]
-> a Bool
}

11
doc/design/importing_trees_from_special_remotes.mdwn
View file

@ -219,6 +219,8 @@ This is an extension to the ExportActions api.
removeExportDirectoryWhenEmpty :: Maybe (ExportDirectory -> Annex Bool)
checkPresentExportWithContentIdentifier :: Key -> ExportLocation -> [ContentIdentifier] -> Annex (Maybe Bool)
listContents finds the current set of files that are stored in the remote,
some of which may have been written by other programs than git-annex,
along with their content identifiers. It returns a list of those, often in
@ -273,6 +275,15 @@ removeExportDirectoryWhenEmpty is used instead of removeExportDirectory.
It should only remove empty directories, and succeeds if there are files
in the directory.
checkPresentExportWithContentIdentifier is used instead of
checkPresentExport. It should verify that one of the provided
ContentIdentifiers matches the current content of the file.
Note that renameExport is never used when the special remote supports
imports, because it may have an implementation that loses changes
to imported files. (For example, it may copy the file to the new name,
and delete the old name.)
## multiple git-annex repos accessing a special remote
If multiple repos can access the remote at the same time, then there's a

7
doc/todo/import_tree.mdwn
View file

@ -10,10 +10,9 @@ this.
## implementation notes
* startExport uses checkPresentExport, but when there's a modified file,
it's not unexported, so it present, so checkPresentExport succeeds,
and so startExport does the wrong thing. Seems to indicate checkPresentExport
needs to be replaced too.
* Check conflict behavior for both conflicting edits to existing file,
and conflicting new files. Note need to check both sequences
import,export and export,import.
* Should the ContentIdentifier db be multiwriter? It would simplify
the situation with the long-lived lock of it in adjustExportImport