{- git-annex import from remotes
-
- - Copyright 2019-2020 Joey Hess <id@joeyh.name>
+ - Copyright 2019-2021 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
:: Remote
-> ImportTreeConfig
-> ImportCommitConfig
- -> ImportableContents (Either Sha Key)
+ -> ImportableContentsChunkable Annex (Either Sha Key)
-> Annex (Maybe Ref)
buildImportCommit remote importtreeconfig importcommitconfig importable =
case importCommitTracking importcommitconfig of
recordImportTree
:: Remote
-> ImportTreeConfig
- -> ImportableContents (Either Sha Key)
+ -> ImportableContentsChunkable Annex (Either Sha Key)
-> Annex (History Sha, Annex ())
recordImportTree remote importtreeconfig importable = do
imported@(History finaltree _) <- buildImportTrees basetree subdir importable
- that location, replacing any object that was there.
-}
buildImportTrees
+ :: Ref
+ -> Maybe TopFilePath
+ -> ImportableContentsChunkable Annex (Either Sha Key)
+ -> Annex (History Sha)
+buildImportTrees basetree msubdir (ImportableContentsComplete importable) = do
+ repo <- Annex.gitRepo
+ withMkTreeHandle repo $ buildImportTrees' basetree msubdir importable
+buildImportTrees basetree msubdir importable@(ImportableContentsChunked {}) = do
+ repo <- Annex.gitRepo
+ withMkTreeHandle repo $ \hdl ->
+ History
+ <$> go hdl
+ <*> buildImportTreesHistory basetree msubdir
+ (importableHistoryComplete importable) hdl
+ where
+ go hdl = do
+ tree <- gochunks [] (importableContentsChunk importable) hdl
+ importtree <- liftIO $ recordTree' hdl tree
+ graftImportTree basetree msubdir importtree hdl
+
+ gochunks l c hdl = do
+ let subdir = importChunkSubDir $ importableContentsSubDir c
+ -- Full directory prefix where the sub tree is located.
+ let fullprefix = asTopFilePath $ case msubdir of
+ Nothing -> subdir
+ Just d -> getTopFilePath d Posix.</> subdir
+ Tree ts <- convertImportTree (Just fullprefix) $
+ map (\(p, i) -> (mkImportLocation p, i))
+ (importableContentsSubTree c)
+ -- Record this subtree before getting next chunk, this
+ -- avoids buffering all the chunks into memory.
+ tc <- liftIO $ recordSubTree hdl $
+ NewSubTree (asTopFilePath subdir) ts
+ importableContentsNextChunk c >>= \case
+ Nothing -> return (Tree (tc:l))
+ Just c' -> gochunks (tc:l) c' hdl
+
+buildImportTrees'
:: Ref
-> Maybe TopFilePath
-> ImportableContents (Either Sha Key)
+ -> MkTreeHandle
-> Annex (History Sha)
-buildImportTrees basetree msubdir importable = History
- <$> (buildtree (importableContents importable) =<< Annex.gitRepo)
- <*> buildhistory
+buildImportTrees' basetree msubdir importable hdl = History
+ <$> buildImportTree basetree msubdir (importableContents importable) hdl
+ <*> buildImportTreesHistory basetree msubdir (importableHistory importable) hdl
+
+buildImportTree
+ :: Ref
+ -> Maybe TopFilePath
+ -> [(ImportLocation, Either Sha Key)]
+ -> MkTreeHandle
+ -> Annex Sha
+buildImportTree basetree msubdir ls hdl = do
+ importtree <- liftIO . recordTree' hdl =<< convertImportTree msubdir ls
+ graftImportTree basetree msubdir importtree hdl
+
+graftImportTree
+ :: Ref
+ -> Maybe TopFilePath
+ -> Sha
+ -> MkTreeHandle
+ -> Annex Sha
+graftImportTree basetree msubdir tree hdl = case msubdir of
+ Nothing -> return tree
+ Just subdir -> inRepo $ \repo ->
+ graftTree' tree subdir basetree repo hdl
+
+convertImportTree :: Maybe TopFilePath -> [(ImportLocation, Either Sha Key)] -> Annex Tree
+convertImportTree msubdir ls = treeItemsToTree <$> mapM mktreeitem ls
where
- buildhistory = S.fromList
- <$> mapM (buildImportTrees basetree msubdir)
- (importableHistory importable)
-
- buildtree ls repo = withMkTreeHandle repo $ \hdl -> do
- importtree <- liftIO . recordTree' hdl
- . treeItemsToTree
- =<< mapM mktreeitem ls
- case msubdir of
- Nothing -> return importtree
- Just subdir -> liftIO $
- graftTree' importtree subdir basetree repo hdl
-
mktreeitem (loc, v) = case v of
Right k -> do
relf <- fromRepo $ fromTopFilePath topf
topf = asTopFilePath $
maybe lf (\sd -> getTopFilePath sd P.</> lf) msubdir
+buildImportTreesHistory
+ :: Ref
+ -> Maybe TopFilePath
+ -> [ImportableContents (Either Sha Key)]
+ -> MkTreeHandle
+ -> Annex (S.Set (History Sha))
+buildImportTreesHistory basetree msubdir history hdl = S.fromList
+ <$> mapM (\ic -> buildImportTrees' basetree msubdir ic hdl) history
+
canImportKeys :: Remote -> Bool -> Bool
canImportKeys remote importcontent =
importcontent || isJust (Remote.importKey ia)
-> ImportTreeConfig
-> Bool
-> Bool
- -> ImportableContents (ContentIdentifier, ByteSize)
- -> Annex (Maybe (ImportableContents (Either Sha Key)))
+ -> ImportableContentsChunkable Annex (ContentIdentifier, ByteSize)
+ -> Annex (Maybe (ImportableContentsChunkable Annex (Either Sha Key)))
importKeys remote importtreeconfig importcontent thirdpartypopulated importablecontents = do
unless (canImportKeys remote importcontent) $
giveup "This remote does not support importing without downloading content."
-- When concurrency is enabled, this set is needed to
-- avoid two threads both importing the same content identifier.
importing <- liftIO $ newTVarIO S.empty
- withExclusiveLock gitAnnexContentIdentifierLock $
- bracket CIDDb.openDb CIDDb.closeDb $ \db -> do
- CIDDb.needsUpdateFromLog db
- >>= maybe noop (CIDDb.updateFromLog db)
- (run (go False cidmap importing importablecontents db))
+ withciddb $ \db -> do
+ CIDDb.needsUpdateFromLog db
+ >>= maybe noop (CIDDb.updateFromLog db)
+ (prepclock (run cidmap importing db))
where
-- When not importing content, reuse the same vector
-- clock for all state that's recorded. This can save
-- a little bit of disk space. Individual file downloads
-- while downloading take too long for this optimisation
-- to be safe to do.
- run a
+ prepclock a
| importcontent = a
| otherwise = reuseVectorClockWhile a
- go oldversion cidmap importing (ImportableContents l h) db = do
+ withciddb = withExclusiveLock gitAnnexContentIdentifierLock .
+ bracket CIDDb.openDb CIDDb.closeDb
+
+ run cidmap importing db = do
largematcher <- largeFilesMatcher
+ case importablecontents of
+ ImportableContentsComplete ic ->
+ go False largematcher cidmap importing db ic >>= return . \case
+ Nothing -> Nothing
+ Just v -> Just $ ImportableContentsComplete v
+ ImportableContentsChunked {} -> do
+ c <- gochunked db (importableContentsChunk importablecontents)
+ gohistory largematcher cidmap importing db (importableHistoryComplete importablecontents) >>= return . \case
+ Nothing -> Nothing
+ Just h -> Just $ ImportableContentsChunked
+ { importableContentsChunk = c
+ , importableHistoryComplete = h
+ }
+
+ go oldversion largematcher cidmap importing db (ImportableContents l h) = do
jobs <- forM l $ \i ->
if thirdpartypopulated
- then thirdpartypopulatedimport cidmap db i
+ then Left <$> thirdpartypopulatedimport db i
else startimport cidmap importing db i oldversion largematcher
l' <- liftIO $ forM jobs $
either pure (atomically . takeTMVar)
if any isNothing l'
then return Nothing
- else do
- h' <- mapM (\ic -> go True cidmap importing ic db) h
- if any isNothing h'
- then return Nothing
- else return $ Just $
- ImportableContents
- (catMaybes l')
- (catMaybes h')
+ else gohistory largematcher cidmap importing db h >>= return . \case
+ Nothing -> Nothing
+ Just h' -> Just $ ImportableContents (catMaybes l') h'
+
+ gohistory largematcher cidmap importing db h = do
+ h' <- mapM (go True largematcher cidmap importing db) h
+ if any isNothing h'
+ then return Nothing
+ else return $ Just $ catMaybes h'
+ gochunked db c
+ -- Downloading cannot be done when chunked, since only
+ -- the first chunk is processed before returning.
+ | importcontent = error "importKeys does not support downloading chunked import"
+ -- Chunked import is currently only used by thirdpartypopulated
+ -- remotes.
+ | not thirdpartypopulated = error "importKeys does not support chunked import when not thirdpartypopulated"
+ | otherwise = do
+ l <- forM (importableContentsSubTree c) $ \(loc, i) -> do
+ let loc' = importableContentsChunkFullLocation (importableContentsSubDir c) loc
+ thirdpartypopulatedimport db (loc', i) >>= return . \case
+ Just (_loc, k) -> Just (loc, k)
+ Nothing -> Nothing
+ return $ ImportableContentsChunk
+ { importableContentsSubDir = importableContentsSubDir c
+ , importableContentsSubTree = catMaybes l
+ , importableContentsNextChunk =
+ importableContentsNextChunk c >>= \case
+ Nothing -> return Nothing
+ Just c' -> withciddb $ \db' ->
+ prepclock $
+ Just <$> gochunked db' c'
+ }
+
waitstart importing cid = liftIO $ atomically $ do
s <- readTVar importing
if S.member cid s
importaction
return (Right job)
- thirdpartypopulatedimport cidmap db (loc, (cid, sz)) =
+ thirdpartypopulatedimport db (loc, (cid, sz)) =
case Remote.importKey ia of
- Nothing -> return $ Left Nothing
+ Nothing -> return Nothing
Just importkey ->
tryNonAsync (importkey loc cid sz nullMeterUpdate) >>= \case
Right (Just k) -> do
- recordcidkey cidmap db cid k
- logChange k (Remote.uuid remote) InfoPresent
- return $ Left $ Just (loc, Right k)
- Right Nothing -> return $ Left Nothing
+ recordcidkey' db cid k
+ logChange k (Remote.uuid remote) InfoPresent
+ return $ Just (loc, Right k)
+ Right Nothing -> return Nothing
Left e -> do
warning (show e)
- return $ Left Nothing
+ return Nothing
importordownload cidmap db (loc, (cid, sz)) largematcher= do
f <- locworktreefile loc
recordcidkey cidmap db cid k = do
liftIO $ atomically $ modifyTVar' cidmap $
M.insert cid k
+ recordcidkey' db cid k
+ recordcidkey' db cid k = do
liftIO $ CIDDb.recordContentIdentifier db rs cid k
CIDLog.recordContentIdentifier rs cid k
- Throws exception if unable to contact the remote.
- Returns Nothing when there is no change since last time.
-}
-getImportableContents :: Remote -> ImportTreeConfig -> CheckGitIgnore -> FileMatcher Annex -> Annex (Maybe (ImportableContents (ContentIdentifier, ByteSize)))
+getImportableContents :: Remote -> ImportTreeConfig -> CheckGitIgnore -> FileMatcher Annex -> Annex (Maybe (ImportableContentsChunkable Annex (ContentIdentifier, ByteSize)))
getImportableContents r importtreeconfig ci matcher = do
Remote.listImportableContents (Remote.importActions r) >>= \case
- Just importable -> do
- dbhandle <- Export.openDb (Remote.uuid r)
- Just <$> filterunwanted dbhandle importable
+ Just (ImportableContentsComplete ic) -> do
+ dbhandle <- opendbhandle
+ Just . ImportableContentsComplete
+ <$> filterunwanted dbhandle ic
+ Just (c@(ImportableContentsChunked {})) -> do
+ dbhandle <- opendbhandle
+ Just <$> filterunwantedchunked dbhandle c
Nothing -> return Nothing
where
filterunwanted dbhandle ic = ImportableContents
<$> filterM (wanted dbhandle) (importableContents ic)
<*> mapM (filterunwanted dbhandle) (importableHistory ic)
+ filterunwantedchunked dbhandle c = ImportableContentsChunked
+ <$> filterunwantedchunk dbhandle (importableContentsChunk c)
+ <*> mapM (filterunwanted dbhandle) (importableHistoryComplete c)
+
+ filterunwantedchunk dbhandle c = ImportableContentsChunk
+ <$> pure (importableContentsSubDir c)
+ <*> filterM (wantedunder dbhandle (importableContentsSubDir c))
+ (importableContentsSubTree c)
+ <*> pure (
+ importableContentsNextChunk c >>= \case
+ Nothing -> return Nothing
+ Just c' -> Just <$> filterunwantedchunk dbhandle c'
+ )
+
+ opendbhandle = Export.openDb (Remote.uuid r)
+
wanted dbhandle (loc, (_cid, sz))
| ingitdir = pure False
| otherwise =
matches = matchesImportLocation matcher loc sz
isknown = isKnownImportLocation dbhandle loc
notignored = notIgnoredImportLocation importtreeconfig ci loc
+
+ wantedunder dbhandle root (loc, v) =
+ wanted dbhandle (importableContentsChunkFullLocation root loc, v)
isKnownImportLocation :: Export.ExportHandle -> ImportLocation -> Annex Bool
isKnownImportLocation dbhandle loc = liftIO $
* Bug fix: Git configs such as annex.verify were incorrectly overriding
per-remote git configs such as remote.name.annex-verify.
(Reversion in version 4.20130323)
+ * borg: Significantly improved memory use when a borg repository
+ contains many archives.
* borg: Avoid trying to extract xattrs, ACLS, and bsdflags when
retrieving from a borg repository.
* Sped up git-annex smudge --clean by 25%.
incrementally verified, when used on NTFS and perhaps other filesystems.
* reinject: Fix crash when reinjecting a file from outside the repository.
(Reversion in version 8.20210621)
- * borg: Some improvements to memory use when importing a lot of archives.
-- Joey Hess <id@joeyh.name> Fri, 03 Sep 2021 12:02:55 -0400
fromtrackingbranch a = inRepo $ a (fromRemoteTrackingBranch tb)
-listContents :: Remote -> ImportTreeConfig -> CheckGitIgnore -> TVar (Maybe (ImportableContents (ContentIdentifier, Remote.ByteSize))) -> CommandStart
+listContents :: Remote -> ImportTreeConfig -> CheckGitIgnore -> TVar (Maybe (ImportableContentsChunkable Annex (ContentIdentifier, Remote.ByteSize))) -> CommandStart
listContents remote importtreeconfig ci tvar = starting "list" ai si $
listContents' remote importtreeconfig ci $ \importable -> do
liftIO $ atomically $ writeTVar tvar importable
ai = ActionItemOther (Just (Remote.name remote))
si = SeekInput []
-listContents' :: Remote -> ImportTreeConfig -> CheckGitIgnore -> (Maybe (ImportableContents (ContentIdentifier, Remote.ByteSize)) -> Annex a) -> Annex a
+listContents' :: Remote -> ImportTreeConfig -> CheckGitIgnore -> (Maybe (ImportableContentsChunkable Annex (ContentIdentifier, Remote.ByteSize)) -> Annex a) -> Annex a
listContents' remote importtreeconfig ci a =
makeImportMatcher remote >>= \case
Right matcher -> tryNonAsync (getImportableContents remote importtreeconfig ci matcher) >>= \case
, err
]
-commitRemote :: Remote -> Branch -> RemoteTrackingBranch -> Maybe Sha -> ImportTreeConfig -> ImportCommitConfig -> ImportableContents (Either Sha Key) -> CommandStart
+commitRemote :: Remote -> Branch -> RemoteTrackingBranch -> Maybe Sha -> ImportTreeConfig -> ImportCommitConfig -> ImportableContentsChunkable Annex (Either Sha Key) -> CommandStart
commitRemote remote branch tb trackingcommit importtreeconfig importcommitconfig importable =
starting "update" ai si $ do
importcommit <- buildImportCommit remote importtreeconfig importcommitconfig importable
getTree,
recordTree,
recordTree',
+ recordSubTree,
TreeItem(..),
treeItemsToTree,
treeItemToLsTreeItem,
graftTree,
graftTree',
withMkTreeHandle,
+ MkTreeHandle,
treeMode,
) where
, File newloc
]
-listImportableContentsM :: AndroidSerial -> AndroidPath -> Annex (Maybe (ImportableContents (ContentIdentifier, ByteSize)))
+listImportableContentsM :: AndroidSerial -> AndroidPath -> Annex (Maybe (ImportableContentsChunkable Annex (ContentIdentifier, ByteSize)))
listImportableContentsM serial adir = adbfind >>= \case
- Just ls -> return $ Just $ ImportableContents (mapMaybe mk ls) []
+ Just ls -> return $ Just $ ImportableContentsComplete $
+ ImportableContents (mapMaybe mk ls) []
Nothing -> giveup "adb find failed"
where
adbfind = adbShell serial
| borgLocal r && not (null p) = Just p
| otherwise = Nothing
-listImportableContentsM :: UUID -> BorgRepo -> ParsedRemoteConfig -> Annex (Maybe (ImportableContents (ContentIdentifier, ByteSize)))
+listImportableContentsM :: UUID -> BorgRepo -> ParsedRemoteConfig -> Annex (Maybe (ImportableContentsChunkable Annex (ContentIdentifier, ByteSize)))
listImportableContentsM u borgrepo c = prompt $ do
imported <- getImported u
ls <- withborglist (locBorgRepo borgrepo) Nothing formatarchivelist $ \as ->
forM (filter (not . S.null) as) $ \archivename ->
- case M.lookup archivename imported of
- Just getfast -> return $ Left (archivename, getfast)
- Nothing -> Right <$>
+ return $ case M.lookup archivename imported of
+ Just getlist -> Left (archivename, getlist)
+ Nothing ->
let archive = borgArchive borgrepo archivename
- in withborglist archive subdir formatfilelist $
+ getlist = withborglist archive subdir formatfilelist $
liftIO . evaluate . force . parsefilelist archivename
+ in Right (archivename, getlist)
if all isLeft ls && M.null (M.difference imported (M.fromList (lefts ls)))
then return Nothing -- unchanged since last time, avoid work
- else Just . mkimportablecontents <$> mapM (either snd pure) ls
+ else Just <$> mkimportablecontents (map (either id id) ls)
where
withborglist what addparam format a = do
environ <- liftIO getEnvironment
parsefilelist archivename (bsz:f:extra:rest) = case readMaybe (fromRawFilePath bsz) of
Nothing -> parsefilelist archivename rest
Just sz ->
- let loc = genImportLocation archivename f
+ let loc = genImportLocation f
-- borg list reports hard links as 0 byte files,
-- with the extra field set to " link to ".
-- When the annex object is a hard link to
-- importableHistory is not used for retrieval, so is not
-- populated with old archives. Instead, a tree of archives
- -- is constructed, by genImportLocation including the archive
- -- name in the ImportLocation.
- mkimportablecontents l = ImportableContents
- { importableContents = concat l
- , importableHistory = []
- }
+ -- is constructed, with a subtree for each archive.
+ mkimportablecontents [] = return $ ImportableContentsComplete $
+ ImportableContents
+ { importableContents = []
+ , importableHistory = []
+ }
+ mkimportablecontents (l:ls) = ImportableContentsChunked
+ <$> mkimportablecontentschunk l ls
+ <*> pure []
+
+ mkimportablecontentschunk (archivename, getlist) rest = do
+ l <- getlist
+ return $ ImportableContentsChunk
+ { importableContentsSubDir =
+ genImportChunkSubDir archivename
+ , importableContentsSubTree = l
+ , importableContentsNextChunk = case rest of
+ (getlist':rest') -> Just
+ <$> mkimportablecontentschunk getlist' rest'
+ [] -> return Nothing
+ }
-- We do not need a ContentIdentifier in order to retrieve a file from
-- borg; the ImportLocation contains all that's needed. So, this is left
borgContentIdentifier :: ContentIdentifier
borgContentIdentifier = ContentIdentifier mempty
+-- Convert a path file a borg archive to a path that can be used as an
+-- ImportLocation. The archive name gets used as a subdirectory,
+-- which this path is inside.
+--
-- Borg does not allow / in the name of an archive, so the archive
-- name will always be the first directory in the ImportLocation.
--
--- Paths in a borg archive are always relative, not absolute, so the use of
--- </> to combine the archive name with the path will always work.
-genImportLocation :: BorgArchiveName -> RawFilePath -> ImportLocation
-genImportLocation archivename p =
- ThirdPartyPopulated.mkThirdPartyImportLocation $
- archivename P.</> p
+-- This scheme also relies on the fact that paths in a borg archive are
+-- always relative, not absolute.
+genImportLocation :: RawFilePath -> RawFilePath
+genImportLocation = fromImportLocation . ThirdPartyPopulated.mkThirdPartyImportLocation
+
+genImportChunkSubDir :: BorgArchiveName -> ImportChunkSubDir
+genImportChunkSubDir = ImportChunkSubDir . fromImportLocation . ThirdPartyPopulated.mkThirdPartyImportLocation
extractImportLocation :: ImportLocation -> (BorgArchiveName, RawFilePath)
extractImportLocation loc = go $ P.splitDirectories $
-- last imported tree. And the contents of those archives can be retrieved
-- by listing the subtree recursively, which will likely be quite a lot
-- faster than running borg.
-getImported :: UUID -> Annex (M.Map BorgArchiveName (Annex [(ImportLocation, (ContentIdentifier, ByteSize))]))
+getImported :: UUID -> Annex (M.Map BorgArchiveName (Annex [(RawFilePath, (ContentIdentifier, ByteSize))]))
getImported u = M.unions <$> (mapM go . exportedTreeishes =<< getExport u)
where
go t = M.fromList . mapMaybe mk
mk ti
| toTreeItemType (LsTree.mode ti) == Just TreeSubtree = Just
( getTopFilePath (LsTree.file ti)
- , getcontents
- (getTopFilePath (LsTree.file ti))
- (LsTree.sha ti)
+ , getcontents (LsTree.sha ti)
)
| otherwise = Nothing
- getcontents archivename t = mapMaybe (mkcontents archivename)
+ getcontents t = mapMaybe mkcontents
<$> inRepo (LsTree.lsTreeStrict LsTree.LsTreeRecursive (LsTree.LsTreeLong False) t)
- mkcontents archivename ti = do
+ mkcontents ti = do
let f = ThirdPartyPopulated.fromThirdPartyImportLocation $
mkImportLocation $ getTopFilePath $ LsTree.file ti
k <- fileKey (P.takeFileName f)
return
- ( genImportLocation archivename f
+ ( genImportLocation f
,
( borgContentIdentifier
-- defaulting to 0 size is ok, this size
mkExportLocation loc'
in go (upFrom loc') =<< tryIO (removeDirectory p)
-listImportableContentsM :: RawFilePath -> Annex (Maybe (ImportableContents (ContentIdentifier, ByteSize)))
+listImportableContentsM :: RawFilePath -> Annex (Maybe (ImportableContentsChunkable Annex (ContentIdentifier, ByteSize)))
listImportableContentsM dir = liftIO $ do
l <- dirContentsRecursive (fromRawFilePath dir)
l' <- mapM (go . toRawFilePath) l
- return $ Just $ ImportableContents (catMaybes l') []
+ return $ Just $ ImportableContentsComplete $
+ ImportableContents (catMaybes l') []
where
go f = do
st <- R.getFileStatus f
-- find only those ImportLocations that are annex object files.
-- All other ImportLocations are ignored.
importKey :: ImportLocation -> ContentIdentifier -> ByteSize -> MeterUpdate -> Annex (Maybe Key)
-importKey loc _cid sz _ = return $ importKey' loc (Just sz)
+importKey loc _cid sz _ = return $ importKey' (fromImportLocation loc) (Just sz)
-importKey' :: ImportLocation -> Maybe ByteSize -> Maybe Key
-importKey' loc msz = case fileKey f of
+importKey' :: RawFilePath -> Maybe ByteSize -> Maybe Key
+importKey' p msz = case fileKey f of
Just k
-- Annex objects always are in a subdirectory with the same
-- name as the filename. If this is not the case for the file
_ -> Just k
Nothing -> Nothing
where
- p = fromImportLocation loc
f = P.takeFileName p
srcobject = T.pack $ bucketExportLocation info src
dstobject = T.pack $ bucketExportLocation info dest
-listImportableContentsS3 :: S3HandleVar -> Remote -> S3Info -> Annex (Maybe (ImportableContents (ContentIdentifier, ByteSize)))
+listImportableContentsS3 :: S3HandleVar -> Remote -> S3Info -> Annex (Maybe (ImportableContentsChunkable Annex (ContentIdentifier, ByteSize)))
listImportableContentsS3 hv r info =
withS3Handle hv $ \case
Nothing -> giveup $ needS3Creds (uuid r)
Just h -> Just <$> go h
where
- go h = liftIO $ runResourceT $ extractFromResourceT =<< startlist h
+ go h = do
+ ic <- liftIO $ runResourceT $ extractFromResourceT =<< startlist h
+ return (ImportableContentsComplete ic)
startlist h
| versioning info = do
{- git-annex import types
-
- - Copyright 2019 Joey Hess <id@joeyh.name>
+ - Copyright 2019-2021 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
import Data.Char
import Control.DeepSeq
import GHC.Generics
+import qualified System.FilePath.Posix.ByteString as Posix
import Types.Export
import Utility.QuickCheck
deriving (Show, Generic)
instance NFData info => NFData (ImportableContents info)
+
+{- ImportableContents, but it can be chunked into subtrees to avoid
+ - all needing to fit in memory at the same time. -}
+data ImportableContentsChunkable m info
+ = ImportableContentsComplete (ImportableContents info)
+ -- ^ Used when not chunking
+ | ImportableContentsChunked
+ { importableContentsChunk :: ImportableContentsChunk m info
+ , importableHistoryComplete :: [ImportableContents info]
+ -- ^ Chunking the history is not supported
+ }
+
+{- A chunk of ImportableContents, which is the entire content of a subtree
+ - of the main tree. Nested subtrees are not allowed. -}
+data ImportableContentsChunk m info = ImportableContentsChunk
+ { importableContentsSubDir :: ImportChunkSubDir
+ , importableContentsSubTree :: [(RawFilePath, info)]
+ -- ^ locations are relative to importableContentsSubDir
+ , importableContentsNextChunk :: m (Maybe (ImportableContentsChunk m info))
+ -- ^ Continuation to get the next chunk.
+ -- Returns Nothing when there are no more chunks.
+ }
+
+newtype ImportChunkSubDir = ImportChunkSubDir { importChunkSubDir :: RawFilePath }
+
+importableContentsChunkFullLocation
+ :: ImportChunkSubDir
+ -> RawFilePath
+ -> ImportLocation
+importableContentsChunkFullLocation (ImportChunkSubDir root) loc =
+ mkImportLocation $ Posix.combine root loc
--
-- Throws exception on failure to access the remote.
-- May return Nothing when the remote is unchanged since last time.
- { listImportableContents :: a (Maybe (ImportableContents (ContentIdentifier, ByteSize)))
+ { listImportableContents :: a (Maybe (ImportableContentsChunkable a (ContentIdentifier, ByteSize)))
-- Generates a Key (of any type) for the file stored on the
-- remote at the ImportLocation. Does not download the file
-- from the remote.
-- since the ContentIdentifier was generated.
--
-- When it returns nothing, the file at the ImportLocation
- -- not by included in the imported tree.
+ -- will not be included in the imported tree.
--
-- When the remote is thirdPartyPopulated, this should check if the
-- file stored on the remote is the content of an annex object,
I don't know if this is a memory leak or just trying to load too much, but it seems like this is a thing you should be able to do on
a machine with 64G of RAM.
+
+> [[fixed|done]] --[[Joey]]
--- /dev/null
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 12"""
+ date="2021-10-08T17:06:05Z"
+ content="""
+I've fixed this problem, my test case tops out at 160 mb now, and adding more
+archives to the borg repo no longer increases memory use. Memory use is now
+proportional to the number of annexed objects in a borg archive.
+"""]]
projects / git-annex.git / commitdiff