fixes to export db lookup when accessing importtree=yes

Now in a fresh clone with a importtree=yes remote enabled,
git annex fsck --from the remote works.
This commit is contained in:
Joey Hess 2019-03-07 14:10:56 -04:00
parent 93025dd59f
commit 9a72785307
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
3 changed files with 37 additions and 34 deletions

View file

@ -19,11 +19,11 @@ module Database.Export (
addExportedLocation,
removeExportedLocation,
getExportedLocation,
getExportedKey,
isExportDirectoryEmpty,
getExportTreeCurrent,
recordExportTreeCurrent,
getExportTree,
getExportTreeKey,
addExportTree,
removeExportTree,
updateExportTree,
@ -155,20 +155,6 @@ getExportedLocation (ExportHandle h _) k = H.queryDbQueue h $ do
where
ik = toIKey k
{- Get the key that was exported to a location.
-
- Note that the database does not currently have an index to make this
- fast.
-
- Note that this does not see recently queued changes.
-}
getExportedKey :: ExportHandle -> ExportLocation -> IO [Key]
getExportedKey (ExportHandle h _) el = H.queryDbQueue h $ do
l <- selectList [ExportedFile ==. ef] []
return $ map (fromIKey . exportedKey . entityVal) l
where
ef = toSFilePath (fromExportLocation el)
{- Note that this does not see recently queued changes. -}
isExportDirectoryEmpty :: ExportHandle -> ExportDirectory -> IO Bool
isExportDirectoryEmpty (ExportHandle h _) d = H.queryDbQueue h $ do
@ -185,6 +171,20 @@ getExportTree (ExportHandle h _) k = H.queryDbQueue h $ do
where
ik = toIKey k
{- Get keys that might be currently exported to a location.
-
- Note that the database does not currently have an index to make this
- fast.
-
- Note that this does not see recently queued changes.
-}
getExportTreeKey :: ExportHandle -> ExportLocation -> IO [Key]
getExportTreeKey (ExportHandle h _) el = H.queryDbQueue h $ do
map (fromIKey . exportTreeKey . entityVal)
<$> selectList [ExportTreeFile ==. ef] []
where
ef = toSFilePath (fromExportLocation el)
addExportTree :: ExportHandle -> Key -> ExportLocation -> IO ()
addExportTree h k loc = queueDb h $
void $ insertUnique $ ExportTree ik ef

View file

@ -135,25 +135,27 @@ adjustExportImport r = case M.lookup "exporttree" (config r) of
isimport r' exportdbv = do
ciddbv <- prepciddb
let getknowncids db loc = do
exportdb <- getexportdb exportdbv
ks <- liftIO $ Export.getExportedKey exportdb loc
liftIO $ concat
<$> mapM (ContentIdentifier.getContentIdentifiers db (uuid r')) ks
let checkpresent k loc = do
let keycids k = do
db <- getciddb ciddbv
liftIO $ ContentIdentifier.getContentIdentifiers db (uuid r') k
let checkpresent k loc =
checkPresentExportWithContentIdentifier
(importActions r')
k loc
=<< getknowncids db loc
k loc
=<< keycids k
return $ r'
{ exportActions = (exportActions r')
{ storeExport = \f k loc p -> do
db <- getciddb ciddbv
knowncids <- getknowncids db loc
storeExportWithContentIdentifier (importActions r') f k loc knowncids p >>= \case
exportdb <- getexportdb exportdbv
updateexportdb exportdb exportdbv
oldks <- liftIO $ Export.getExportTreeKey exportdb loc
oldcids <- liftIO $ concat
<$> mapM (ContentIdentifier.getContentIdentifiers db (uuid r')) oldks
liftIO $ print ("cids", oldcids)
storeExportWithContentIdentifier (importActions r') f k loc oldcids p >>= \case
Nothing -> return False
Just newcid -> do
withExclusiveLock gitAnnexContentIdentifierLock $ do
@ -161,10 +163,9 @@ adjustExportImport r = case M.lookup "exporttree" (config r) of
liftIO $ ContentIdentifier.flushDbQueue db
recordContentIdentifier (uuid r') newcid k
return True
, removeExport = \k loc -> do
db <- getciddb ciddbv
, removeExport = \k loc ->
removeExportWithContentIdentifier (importActions r') k loc
=<< getknowncids db loc
=<< keycids k
, removeExportDirectory = removeExportDirectoryWhenEmpty (importActions r')
-- renameExport is optional, and the
-- remote's implementation may
@ -273,6 +274,10 @@ adjustExportImport r = case M.lookup "exporttree" (config r) of
Nothing -> ifM (liftIO $ atomically $ tryPutTMVar lcklckv ())
( do
db <- ContentIdentifier.openDb
ContentIdentifier.needsUpdateFromLog db >>= \case
Just v -> withExclusiveLock gitAnnexContentIdentifierLock $
ContentIdentifier.updateFromLog db v
Nothing -> noop
liftIO $ atomically $ putTMVar dbtv db
return db
-- loser waits for winner to open the db and

View file

@ -10,14 +10,12 @@ this.
## implementation notes
* getknowncids needs to update the export db when the git-annex branch is
newer, otherwise it can miss the most recent information
Note that updating the db needs to write lock it.
* Need to support annex-tracking-branch configuration, which documentation
says makes git-annex sync and assistant do imports.
* git-annex import needs to say when it's downloading files, display
progress bars, and support concurrent downloads.
* When on an adjusted unlocked branch, need to import the files unlocked.
Also, the tracking branch code needs to know about such branches,
currently it will generate the wrong tracking branch.