{- git-annex import from remotes - - Copyright 2019-2023 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} {-# LANGUAGE OverloadedStrings #-} module Annex.Import ( ImportTreeConfig(..), ImportCommitConfig(..), buildImportCommit, buildImportTrees, recordImportTree, canImportKeys, ImportResult(..), Imported, importChanges, importKeys, makeImportMatcher, getImportableContents, ) where import Annex.Common import Types.Import import qualified Types.Remote as Remote import Git.Types import Git.Tree import Git.Sha import Git.FilePath import Git.History import qualified Git.DiffTree import qualified Git.Ref import qualified Git.Branch import qualified Annex import Annex.Link import Annex.LockFile import Annex.Content import Annex.Export import Annex.RemoteTrackingBranch import Annex.HashObject import Annex.Transfer import Annex.CheckIgnore import Annex.CatFile import Annex.VectorClock import Command import Backend import Types.Key import Types.KeySource import Messages.Progress import Utility.DataUnits import Utility.Metered import Utility.Hash (sha1s) import Logs.Import import Logs.Export import Logs.Location import Logs.PreferredContent import Types.FileMatcher import Annex.FileMatcher import qualified Utility.Matcher import qualified Database.Export as Export import qualified Database.ContentIdentifier as CIDDb import qualified Logs.ContentIdentifier as CIDLog import Backend.Utilities import Control.Concurrent.STM import qualified Data.Map.Strict as M import qualified Data.Set as S import qualified System.FilePath.Posix.ByteString as Posix import qualified System.FilePath.ByteString as P import qualified Data.ByteArray.Encoding as BA {- Configures how to build an import tree. -} data ImportTreeConfig = ImportTree -- ^ Import the tree as-is from the remote. | ImportSubTree TopFilePath Sha -- ^ Import a tree from the remote and graft it into a subdirectory -- of the existing tree whose Sha is provided, replacing anything -- that was there before. deriving (Show) {- Configures how to build an import commit. -} data ImportCommitConfig = ImportCommitConfig { importCommitTracking :: Maybe Sha -- ^ Current commit on the remote tracking branch. , importCommitMode :: Git.Branch.CommitMode , importCommitMessage :: String } {- Buils a commit for an import from a special remote. - - When there are no changes to make (importCommitTracking - already matches what was imported), returns Nothing. - - After importing from a remote, exporting the same thing back to the - remote should be a no-op. So, the export log and database are - updated to reflect the imported tree. - - This does not download any content from a remote. But since it needs the - Key of imported files to be known, its caller will have to first download - new files in order to generate keys for them. -} buildImportCommit :: Remote -> ImportTreeConfig -> ImportCommitConfig -> Imported -> Annex (Maybe Ref) buildImportCommit remote importtreeconfig importcommitconfig imported = case importCommitTracking importcommitconfig of Nothing -> go Nothing Just trackingcommit -> inRepo (Git.Ref.tree trackingcommit) >>= \case Nothing -> go Nothing Just _ -> go (Just trackingcommit) where go trackingcommit = do (importedtree, updatestate) <- recordImportTree remote importtreeconfig imported buildImportCommit' remote importcommitconfig trackingcommit importedtree >>= \case Just finalcommit -> do updatestate return (Just finalcommit) Nothing -> return Nothing {- Builds a tree for an import from a special remote. - - Also returns an action that can be used to update - all the other state to record the import. -} recordImportTree :: Remote -> ImportTreeConfig -> Imported -> Annex (History Sha, Annex ()) recordImportTree remote importtreeconfig imported = do importedtree@(History finaltree _) <- buildImportTrees basetree subdir imported return (importedtree, updatestate finaltree) where basetree = case importtreeconfig of ImportTree -> emptyTree ImportSubTree _ sha -> sha subdir = case importtreeconfig of ImportTree -> Nothing ImportSubTree dir _ -> Just dir updatestate finaltree = do importedtree <- case subdir of Nothing -> pure finaltree Just dir -> let subtreeref = Ref $ fromRef' finaltree <> ":" <> getTopFilePath dir in fromMaybe emptyTree <$> inRepo (Git.Ref.tree subtreeref) updateexportdb importedtree oldexport <- updateexportlog importedtree updatelocationlog oldexport importedtree updateexportdb importedtree = do db <- Export.openDb (Remote.uuid remote) Export.writeLockDbWhile db $ do prevtree <- liftIO $ fromMaybe emptyTree <$> Export.getExportTreeCurrent db when (importedtree /= prevtree) $ do Export.updateExportDb db prevtree importedtree liftIO $ Export.recordExportTreeCurrent db importedtree Export.closeDb db updateexportlog importedtree = do oldexport <- getExport (Remote.uuid remote) recordExport (Remote.uuid remote) importedtree $ ExportChange { oldTreeish = exportedTreeishes oldexport , newTreeish = importedtree } return oldexport -- downloadImport takes care of updating the location log -- for the local repo when keys are downloaded, and also updates -- the location log for the remote for keys that are present in it. -- That leaves updating the location log for the remote for keys -- that have had the last copy of their content removed from it. -- -- This must run after the export database has been updated -- and flushed to disk, so it can query it. updatelocationlog oldexport finaltree = do let stillpresent db k = liftIO $ not . null <$> Export.getExportedLocation db k let updater db moldkey _newkey _ = case moldkey of Just oldkey | not (isGitShaKey oldkey) -> unlessM (stillpresent db oldkey) $ logChange oldkey (Remote.uuid remote) InfoMissing _ -> noop -- When the remote is versioned, it still contains keys -- that are not present in the new tree. unless (Remote.versionedExport (Remote.exportActions remote)) $ do db <- Export.openDb (Remote.uuid remote) forM_ (exportedTreeishes oldexport) $ \oldtree -> Export.runExportDiffUpdater updater db oldtree finaltree Export.closeDb db buildImportCommit' :: Remote -> ImportCommitConfig -> Maybe Sha -> History Sha -> Annex (Maybe Sha) buildImportCommit' remote importcommitconfig mtrackingcommit imported@(History ti _) = case mtrackingcommit of Nothing -> Just <$> mkcommitsunconnected imported Just trackingcommit -> do -- Get history of tracking branch to at most -- one more level deep than what was imported, -- so we'll have enough history to compare, -- but not spend too much time getting it. let maxdepth = succ importeddepth inRepo (getHistoryToDepth maxdepth trackingcommit) >>= go trackingcommit where go _ Nothing = Just <$> mkcommitsunconnected imported go trackingcommit (Just h) -- If the tracking branch head is a merge commit -- and one side of the merge matches the history, -- nothing new needs to be committed. | t == ti && any sametodepth (S.toList s) = return Nothing -- If the tracking branch matches the history, -- nothing new needs to be committed. -- (This is unlikely to happen.) | sametodepth h' = return Nothing | otherwise = do importedcommit <- case getRemoteTrackingBranchImportHistory h of Nothing -> mkcommitsunconnected imported Just oldimported@(History oldhc _) | importeddepth == 1 -> mkcommitconnected imported oldimported | otherwise -> do let oldimportedtrees = mapHistory historyCommitTree oldimported mknewcommits oldhc oldimportedtrees imported ti' <- addBackExportExcluded remote ti Just <$> makeRemoteTrackingBranchMergeCommit' trackingcommit importedcommit ti' where h'@(History t s) = mapHistory historyCommitTree h importeddepth = historyDepth imported sametodepth b = imported == truncateHistoryToDepth importeddepth b mkcommit parents tree = inRepo $ Git.Branch.commitTree (importCommitMode importcommitconfig) (importCommitMessage importcommitconfig) parents tree -- Start a new history of import commits, not connected to any -- prior import commits. mkcommitsunconnected (History importedtree hs) = do parents <- mapM mkcommitsunconnected (S.toList hs) mkcommit parents importedtree -- Commit the new history connected with the old history. -- Used when the import is not versioned, so the history depth is 1. mkcommitconnected (History importedtree _) (History oldhc _) = do let parents = [historyCommit oldhc] mkcommit parents importedtree -- Reuse the commits from the old imported History when possible. mknewcommits oldhc old new@(History importedtree hs) | old == new = return $ historyCommit oldhc | otherwise = do parents <- mapM (mknewcommits oldhc old) (S.toList hs) mkcommit parents importedtree {- Builds a history of git trees for an import. - - When a subdir is provided, the imported tree is grafted into - the basetree at that location, replacing any object that was there. -} buildImportTrees :: Ref -> Maybe TopFilePath -> Imported -> Annex (History Sha) buildImportTrees basetree msubdir (ImportedFull imported) = buildImportTreesGeneric convertImportTree basetree msubdir imported buildImportTrees basetree msubdir (ImportedDiff (LastImportedTree oldtree) imported) = do importtree <- if null (importableContents imported) then pure oldtree else applydiff repo <- Annex.gitRepo t <- withMkTreeHandle repo $ graftImportTree basetree msubdir importtree -- Diffing is not currently implemented when the history is not empty. return (History t mempty) where applydiff = do let (removed, new) = partition isremoved (importableContents imported) newtreeitems <- catMaybes <$> mapM mktreeitem new let removedfiles = map (mkloc . fst) removed inRepo $ adjustTree (pure . Just) -- ^ keep files that are not added/removed the same newtreeitems (\_oldti newti -> newti) -- ^ prefer newly added version of file removedfiles oldtree mktreeitem (loc, DiffChanged v) = Just <$> mkImportTreeItem msubdir loc v mktreeitem (_, DiffRemoved) = pure Nothing mkloc = asTopFilePath . fromImportLocation isremoved (_, v) = v == DiffRemoved convertImportTree :: Maybe TopFilePath -> [(ImportLocation, Either Sha Key)] -> Annex Tree convertImportTree msubdir ls = treeItemsToTree <$> mapM (uncurry $ mkImportTreeItem msubdir) ls mkImportTreeItem :: Maybe TopFilePath -> ImportLocation -> Either Sha Key -> Annex TreeItem mkImportTreeItem msubdir loc v = case v of Right k -> do relf <- fromRepo $ fromTopFilePath topf symlink <- calcRepo $ gitAnnexLink relf k linksha <- hashSymlink symlink return $ TreeItem treepath (fromTreeItemType TreeSymlink) linksha Left sha -> return $ TreeItem treepath (fromTreeItemType TreeFile) sha where lf = fromImportLocation loc treepath = asTopFilePath lf topf = asTopFilePath $ maybe lf (\sd -> getTopFilePath sd P. lf) msubdir {- Builds a history of git trees using ContentIdentifiers. - - These are not the final trees that are generated by the import, which - use Keys. The purpose of these trees is to allow quickly determining - which files in the import have changed, and which are unchanged, to - avoid needing to look up the Keys for unchanged ContentIdentifiers. - When the import has a large number of files, that can be slow. -} buildContentIdentifierTree :: ImportableContentsChunkable Annex (ContentIdentifier, ByteSize) -> Annex (History Sha, M.Map Sha (ContentIdentifier, ByteSize)) buildContentIdentifierTree importable = do mv <- liftIO $ newTVarIO M.empty r <- buildImportTreesGeneric (convertContentIdentifierTree mv) emptyTree Nothing importable m <- liftIO $ atomically $ readTVar mv return (r, m) {- For speed, and to avoid bloating the repository, the ContentIdentifiers - are not actually checked into git, instead a sha1 hash is calculated - internally. -} convertContentIdentifierTree :: TVar (M.Map Sha (ContentIdentifier, ByteSize)) -> Maybe TopFilePath -> [(ImportLocation, (ContentIdentifier, ByteSize))] -> Annex Tree convertContentIdentifierTree mv _ ls = do let (tis, ml) = unzip (map mktreeitem ls) liftIO $ atomically $ modifyTVar' mv $ M.union (M.fromList ml) return (treeItemsToTree tis) where mktreeitem (loc, v@((ContentIdentifier cid), _sz)) = (TreeItem p mode sha1, (sha1, v)) where p = asTopFilePath (fromImportLocation loc) mode = fromTreeItemType TreeFile -- Note that this hardcodes sha1, even if git has started -- defaulting to some other checksum method. That should be -- ok, hopefully. This checksum never needs to be verified -- by git, which is why this does not bother to prefix the -- cid with its length, like git would. sha1 = Ref $ BA.convertToBase BA.Base16 $ sha1s cid buildImportTreesGeneric :: (Maybe TopFilePath -> [(ImportLocation, v)] -> Annex Tree) -> Ref -> Maybe TopFilePath -> ImportableContentsChunkable Annex v -> Annex (History Sha) buildImportTreesGeneric converttree basetree msubdir (ImportableContentsComplete importable) = do repo <- Annex.gitRepo withMkTreeHandle repo $ buildImportTreesGeneric' converttree basetree msubdir importable buildImportTreesGeneric converttree basetree msubdir importable@(ImportableContentsChunked {}) = do repo <- Annex.gitRepo withMkTreeHandle repo $ \hdl -> History <$> go hdl <*> buildImportTreesHistory converttree 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 <- converttree (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 buildImportTreesGeneric' :: (Maybe TopFilePath -> [(ImportLocation, v)] -> Annex Tree) -> Ref -> Maybe TopFilePath -> ImportableContents v -> MkTreeHandle -> Annex (History Sha) buildImportTreesGeneric' converttree basetree msubdir importable hdl = History <$> buildImportTree converttree basetree msubdir (importableContents importable) hdl <*> buildImportTreesHistory converttree basetree msubdir (importableHistory importable) hdl buildImportTree :: (Maybe TopFilePath -> [(ImportLocation, v)] -> Annex Tree) -> Ref -> Maybe TopFilePath -> [(ImportLocation, v)] -> MkTreeHandle -> Annex Sha buildImportTree converttree basetree msubdir ls hdl = do importtree <- liftIO . recordTree' hdl =<< converttree 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 buildImportTreesHistory :: (Maybe TopFilePath -> [(ImportLocation, v)] -> Annex Tree) -> Ref -> Maybe TopFilePath -> [ImportableContents v] -> MkTreeHandle -> Annex (S.Set (History Sha)) buildImportTreesHistory converttree basetree msubdir history hdl = S.fromList <$> mapM (\ic -> buildImportTreesGeneric' converttree basetree msubdir ic hdl) history canImportKeys :: Remote -> Bool -> Bool canImportKeys remote importcontent = importcontent || isJust (Remote.importKey ia) where ia = Remote.importActions remote -- Result of an import. ImportUnfinished indicates that some file failed to -- be imported. Running again should resume where it left off. data ImportResult t = ImportFinished t | ImportUnfinished data Diffed t = DiffChanged t | DiffRemoved deriving (Eq) data Imported = ImportedFull (ImportableContentsChunkable Annex (Either Sha Key)) | ImportedDiff LastImportedTree (ImportableContents (Diffed (Either Sha Key))) newtype LastImportedTree = LastImportedTree Sha {- Diffs between the previous and current ContentIdentifier trees, and - runs importKeys on only the changed files. - - This will download the same content as if importKeys were run on all - files, but this speeds it up significantly when there are a lot of files - and only a few have changed. importKeys has to look up each - ContentIdentifier to see if a Key is known for it. This avoids doing - that lookup on files that have not changed. - - Diffing is not currently implemented when there is a History. -} importChanges :: Remote -> ImportTreeConfig -> Bool -> Bool -> ImportableContentsChunkable Annex (ContentIdentifier, ByteSize) -> Annex (ImportResult Imported) importChanges remote importtreeconfig importcontent thirdpartypopulated importablecontents = do ((History currcidtree currhistory), cidtreemap) <- buildContentIdentifierTree importablecontents -- diffimport below does not handle history, so when there is -- history, do a full import. if not (S.null currhistory) then fullimport currcidtree else do getContentIdentifierTree (Remote.uuid remote) >>= \case Nothing -> fullimport currcidtree Just prevcidtree -> candiffimport prevcidtree >>= \case Nothing -> fullimport currcidtree Just lastimportedtree -> diffimport cidtreemap prevcidtree currcidtree lastimportedtree where remember = recordContentIdentifierTree (Remote.uuid remote) -- In order to use a diff, the previous ContentIdentifier tree must -- not have been garbage collected. Which can happen since there -- are no git refs to it. -- -- Also, a tree must have been imported before, and that tree must -- also have not been garbage collected (which is less likely to -- happen due to the remote tracking branch). candiffimport prevcidtree = catObjectMetaData prevcidtree >>= \case Nothing -> return Nothing Just _ -> getLastImportedTree remote >>= \case Nothing -> return Nothing Just lastimported@(LastImportedTree t) -> ifM (isJust <$> catObjectMetaData t) ( return (Just lastimported) , return Nothing ) fullimport currcidtree = importKeys remote importtreeconfig importcontent thirdpartypopulated importablecontents >>= \case ImportUnfinished -> return ImportUnfinished ImportFinished r -> do remember currcidtree return $ ImportFinished $ ImportedFull r diffimport cidtreemap prevcidtree currcidtree lastimportedtree = do (diff, cleanup) <- inRepo $ Git.DiffTree.diffTreeRecursive prevcidtree currcidtree let (removed, changed) = partition isremoval diff let mkicchanged ti = do v <- M.lookup (Git.DiffTree.dstsha ti) cidtreemap return (mkloc ti, v) let ic = ImportableContentsComplete $ ImportableContents { importableContents = mapMaybe mkicchanged changed , importableHistory = [] } importKeys remote importtreeconfig importcontent thirdpartypopulated ic >>= \case ImportUnfinished -> do void $ liftIO cleanup return ImportUnfinished ImportFinished (ImportableContentsComplete ic') -> liftIO cleanup >>= \case False -> return ImportUnfinished True -> do remember currcidtree return $ ImportFinished $ ImportedDiff lastimportedtree (mkdiff ic' removed) -- importKeys is not passed ImportableContentsChunked -- above, so it cannot return it ImportFinished (ImportableContentsChunked {}) -> error "internal" isremoval ti = Git.DiffTree.dstsha ti `elem` nullShas mkloc = mkImportLocation . getTopFilePath . Git.DiffTree.file mkdiff ic removed = ImportableContents { importableContents = diffremoved ++ diffchanged , importableHistory = [] } where diffchanged = map (\(loc, v) -> (loc, DiffChanged v)) (importableContents ic) diffremoved = map (\ti -> (mkloc ti, DiffRemoved)) removed {- Gets the tree that was last imported from the remote - (or exported to it if an export happened after the last import). -} getLastImportedTree :: Remote -> Annex (Maybe LastImportedTree) getLastImportedTree remote = do db <- Export.openDb (Remote.uuid remote) mtree <- liftIO $ Export.getExportTreeCurrent db Export.closeDb db return (LastImportedTree <$> mtree) {- Downloads all new ContentIdentifiers, or when importcontent is False, - generates Keys without downloading. - - Generates either a Key or a git Sha, depending on annex.largefiles. - But when importcontent is False, it cannot match on annex.largefiles - (or generate a git Sha), so always generates Keys. - - Supports concurrency when enabled. - - Note that, when a ContentIdentifier has been imported before, - generates the same thing that was imported before, so annex.largefiles - is not reapplied. -} importKeys :: Remote -> ImportTreeConfig -> Bool -> Bool -> ImportableContentsChunkable Annex (ContentIdentifier, ByteSize) -> Annex (ImportResult (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." -- This map is used to remember content identifiers that -- were just imported, before they have necessarily been -- stored in the database. This way, if the same content -- identifier appears multiple times in the -- importablecontents (eg when it has a history), -- they will only be imported once. cidmap <- liftIO $ newTVarIO M.empty -- When concurrency is enabled, this set is needed to -- avoid two threads both importing the same content identifier. importing <- liftIO $ newTVarIO S.empty withciddb $ \db -> do db' <- CIDDb.needsUpdateFromLog db >>= maybe (pure db) (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. prepclock a | importcontent = a | otherwise = reuseVectorClockWhile a withciddb a = do cidlck <- calcRepo' gitAnnexContentIdentifierLock withExclusiveLock cidlck $ bracket CIDDb.openDb CIDDb.closeDb a run cidmap importing db = do largematcher <- largeFilesMatcher case importablecontents of ImportableContentsComplete ic -> go False largematcher cidmap importing db ic >>= return . \case Nothing -> ImportUnfinished Just v -> ImportFinished $ ImportableContentsComplete v ImportableContentsChunked {} -> do c <- gochunked db (importableContentsChunk importablecontents) gohistory largematcher cidmap importing db (importableHistoryComplete importablecontents) >>= return . \case Nothing -> ImportUnfinished Just h -> ImportFinished $ ImportableContentsChunked { importableContentsChunk = c , importableHistoryComplete = h } go oldversion largematcher cidmap importing db (ImportableContents l h) = do jobs <- forM l $ \i -> if thirdpartypopulated 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 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 = giveup "importKeys does not support downloading chunked import" -- Chunked import is currently only used by thirdpartypopulated -- remotes. | not thirdpartypopulated = giveup "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 then retry else writeTVar importing $ S.insert cid s signaldone importing cid = liftIO $ atomically $ do s <- readTVar importing writeTVar importing $ S.delete cid s startimport cidmap importing db i@(loc, (cid, _sz)) oldversion largematcher = getcidkey cidmap db cid >>= \case (k:ks) -> -- If the same content was imported before -- yielding multiple different keys, it's not clear -- which is best to use this time, so pick the -- first in the list. But, if any of them is a -- git sha, use it, because the content must -- be included in the git repo then. let v = case mapMaybe keyGitSha (k:ks) of (sha:_) -> Left sha [] -> Right k in return $ Left $ Just (loc, v) [] -> do job <- liftIO $ newEmptyTMVarIO let ai = ActionItemOther (Just (QuotedPath (fromImportLocation loc))) let si = SeekInput [] let importaction = starting ("import " ++ Remote.name remote) ai si $ do when oldversion $ showNote "old version" tryNonAsync (importordownload cidmap i largematcher) >>= \case Left e -> next $ do warning (UnquotedString (show e)) liftIO $ atomically $ putTMVar job Nothing return False Right r -> next $ do liftIO $ atomically $ putTMVar job r return True commandAction $ bracket_ (waitstart importing cid) (signaldone importing cid) importaction return (Right job) thirdpartypopulatedimport db (loc, (cid, sz)) = case Remote.importKey ia of Nothing -> return Nothing Just importkey -> tryNonAsync (importkey loc cid sz nullMeterUpdate) >>= \case Right (Just k) -> do recordcidkeyindb db cid k logChange k (Remote.uuid remote) InfoPresent return $ Just (loc, Right k) Right Nothing -> return Nothing Left e -> do warning (UnquotedString (show e)) return Nothing importordownload cidmap (loc, (cid, sz)) largematcher = do f <- locworktreefile loc matcher <- largematcher f -- When importing a key is supported, always use it rather -- than downloading and retrieving a key, to avoid -- generating trees with different keys for the same content. let act = if importcontent then case Remote.importKey ia of Nothing -> dodownload Just _ -> if Utility.Matcher.introspect matchNeedsFileContent (fst matcher) then dodownload else doimport else doimport act cidmap (loc, (cid, sz)) f matcher doimport cidmap (loc, (cid, sz)) f matcher = case Remote.importKey ia of Nothing -> error "internal" -- checked earlier Just importkey -> do when (Utility.Matcher.introspect matchNeedsFileContent (fst matcher)) $ giveup "annex.largefiles configuration examines file contents, so cannot import without content." let mi = MatchingInfo ProvidedInfo { providedFilePath = Just f , providedKey = Nothing , providedFileSize = Just sz , providedMimeType = Nothing , providedMimeEncoding = Nothing , providedLinkType = Nothing } let bwlimit = remoteAnnexBwLimit (Remote.gitconfig remote) islargefile <- checkMatcher' matcher mi mempty metered Nothing sz bwlimit $ const $ if islargefile then doimportlarge importkey cidmap loc cid sz f else doimportsmall cidmap loc cid sz doimportlarge importkey cidmap loc cid sz f p = tryNonAsync importer >>= \case Right (Just (k, True)) -> return $ Just (loc, Right k) Right _ -> return Nothing Left e -> do warning (UnquotedString (show e)) return Nothing where importer = do -- Don't display progress when generating -- key, if the content will later be -- downloaded, which is a more expensive -- operation generally. let p' = if importcontent then nullMeterUpdate else p importkey loc cid sz p' >>= \case Nothing -> return Nothing Just k -> checkSecureHashes k >>= \case Nothing -> do recordcidkey cidmap cid k logChange k (Remote.uuid remote) InfoPresent if importcontent then getcontent k else return (Just (k, True)) Just msg -> giveup (msg ++ " to import") getcontent :: Key -> Annex (Maybe (Key, Bool)) getcontent k = do let af = AssociatedFile (Just f) let downloader p' tmpfile = do _ <- Remote.retrieveExportWithContentIdentifier ia loc [cid] (fromRawFilePath tmpfile) (Left k) (combineMeterUpdate p' p) ok <- moveAnnex k af tmpfile when ok $ logStatus k InfoPresent return (Just (k, ok)) checkDiskSpaceToGet k Nothing $ notifyTransfer Download af $ download' (Remote.uuid remote) k af Nothing stdRetry $ \p' -> withTmp k $ downloader p' -- The file is small, so is added to git, so while importing -- without content does not retrieve annexed files, it does -- need to retrieve this file. doimportsmall cidmap loc cid sz p = do let downloader tmpfile = do (k, _) <- Remote.retrieveExportWithContentIdentifier ia loc [cid] (fromRawFilePath tmpfile) (Right (mkkey tmpfile)) p case keyGitSha k of Just sha -> do recordcidkey cidmap cid k return sha Nothing -> error "internal" checkDiskSpaceToGet tmpkey Nothing $ withTmp tmpkey $ \tmpfile -> tryNonAsync (downloader tmpfile) >>= \case Right sha -> return $ Just (loc, Left sha) Left e -> do warning (UnquotedString (show e)) return Nothing where tmpkey = importKey cid sz mkkey tmpfile = gitShaKey <$> hashFile tmpfile dodownload cidmap (loc, (cid, sz)) f matcher = do let af = AssociatedFile (Just f) let downloader tmpfile p = do (k, _) <- Remote.retrieveExportWithContentIdentifier ia loc [cid] (fromRawFilePath tmpfile) (Right (mkkey tmpfile)) p case keyGitSha k of Nothing -> do ok <- moveAnnex k af tmpfile when ok $ do recordcidkey cidmap cid k logStatus k InfoPresent logChange k (Remote.uuid remote) InfoPresent return (Right k, ok) Just sha -> do recordcidkey cidmap cid k return (Left sha, True) let rundownload tmpfile p = tryNonAsync (downloader tmpfile p) >>= \case Right (v, True) -> return $ Just (loc, v) Right (_, False) -> return Nothing Left e -> do warning (UnquotedString (show e)) return Nothing let bwlimit = remoteAnnexBwLimit (Remote.gitconfig remote) checkDiskSpaceToGet tmpkey Nothing $ notifyTransfer Download af $ download' (Remote.uuid remote) tmpkey af Nothing stdRetry $ \p -> withTmp tmpkey $ \tmpfile -> metered (Just p) tmpkey bwlimit $ const (rundownload tmpfile) where tmpkey = importKey cid sz mkkey tmpfile = do let mi = MatchingFile FileInfo { matchFile = f , contentFile = tmpfile , matchKey = Nothing } islargefile <- checkMatcher' matcher mi mempty if islargefile then do backend <- chooseBackend f let ks = KeySource { keyFilename = f , contentLocation = tmpfile , inodeCache = Nothing } fst <$> genKey ks nullMeterUpdate backend else gitShaKey <$> hashFile tmpfile ia = Remote.importActions remote locworktreefile loc = fromRepo $ fromTopFilePath $ asTopFilePath $ case importtreeconfig of ImportTree -> fromImportLocation loc ImportSubTree subdir _ -> getTopFilePath subdir P. fromImportLocation loc getcidkey cidmap db cid = liftIO $ -- Avoiding querying the database when it's empty speeds up -- the initial import. if CIDDb.databaseIsEmpty db then getcidkeymap cidmap cid else CIDDb.getContentIdentifierKeys db rs cid >>= \case [] -> getcidkeymap cidmap cid l -> return l getcidkeymap cidmap cid = atomically $ maybeToList . M.lookup cid <$> readTVar cidmap recordcidkey cidmap cid k = do liftIO $ atomically $ modifyTVar' cidmap $ M.insert cid k -- Only record in log now; the database will be updated -- later from the log, and the cidmap will be used for now. recordcidkeyinlog cid k recordcidkeyindb db cid k = do liftIO $ CIDDb.recordContentIdentifier db rs cid k recordcidkeyinlog cid k recordcidkeyinlog cid k = CIDLog.recordContentIdentifier rs cid k rs = Remote.remoteStateHandle remote {- Temporary key used for import of a ContentIdentifier while downloading - content, before generating its real key. -} importKey :: ContentIdentifier -> Integer -> Key importKey (ContentIdentifier cid) size = mkKey $ \k -> k { keyName = genKeyName (decodeBS cid) , keyVariety = OtherKey "CID" , keySize = Just size } {-- Export omits non-preferred content from the tree stored on the -- remote. So the import will normally have that content -- omitted (unless something else added files with the same names to the -- special remote). -- -- That presents a problem: Merging the imported tree would result -- in deletion of the files that were excluded from export. -- To avoid that happening, this adds them back to the imported tree. --} addBackExportExcluded :: Remote -> Sha -> Annex Sha addBackExportExcluded remote importtree = getExportExcluded (Remote.uuid remote) >>= \case [] -> return importtree excludedlist -> inRepo $ adjustTree -- don't remove any (pure . Just) excludedlist -- if something was imported with the same -- name as a file that was previously -- excluded from import, use what was imported (\imported _excluded -> imported) [] importtree {- Match the preferred content of the remote at import time. - - Only keyless tokens are supported, because the keys are not known - until an imported file is downloaded, which is too late to bother - excluding it from an import. -} makeImportMatcher :: Remote -> Annex (Either String (FileMatcher Annex)) makeImportMatcher r = load preferredContentKeylessTokens >>= \case Nothing -> return $ Right (matchAll, matcherdesc) Just (Right v) -> return $ Right (v, matcherdesc) Just (Left err) -> load preferredContentTokens >>= \case Just (Left err') -> return $ Left err' _ -> return $ Left $ "The preferred content expression contains terms that cannot be checked when importing: " ++ err where load t = M.lookup (Remote.uuid r) . fst <$> preferredRequiredMapsLoad' t matcherdesc = MatcherDesc "preferred content" {- Gets the ImportableContents from the remote. - - Filters out any paths that include a ".git" component, because git does - not allow storing ".git" in a git repository. While it is possible to - write a git tree that contains that, git will complain and refuse to - check it out. - - Filters out new things not matching the FileMatcher or that are - gitignored. However, files that are already in git get imported - regardless. (Similar to how git add behaves on gitignored files.) - This avoids creating a remote tracking branch that, when merged, - would delete the files. - - 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 (ImportableContentsChunkable Annex (ContentIdentifier, ByteSize))) getImportableContents r importtreeconfig ci matcher = do Remote.listImportableContents (Remote.importActions r) >>= \case 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 = do h <- Export.openDb (Remote.uuid r) void $ Export.updateExportTreeFromLog h return h wanted dbhandle (loc, (_cid, sz)) | ingitdir = pure False | otherwise = isknown <||> (matches <&&> notignored) where -- Checks, from least to most expensive. ingitdir = ".git" `elem` Posix.splitDirectories (fromImportLocation loc) 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 $ not . null <$> Export.getExportTreeKey dbhandle loc matchesImportLocation :: FileMatcher Annex -> ImportLocation -> Integer -> Annex Bool matchesImportLocation matcher loc sz = checkMatcher' matcher mi mempty where mi = MatchingInfo $ ProvidedInfo { providedFilePath = Just (fromImportLocation loc) , providedKey = Nothing , providedFileSize = Just sz , providedMimeType = Nothing , providedMimeEncoding = Nothing , providedLinkType = Nothing } notIgnoredImportLocation :: ImportTreeConfig -> CheckGitIgnore -> ImportLocation -> Annex Bool notIgnoredImportLocation importtreeconfig ci loc = not <$> checkIgnored ci f where f = case importtreeconfig of ImportSubTree dir _ -> getTopFilePath dir P. fromImportLocation loc ImportTree -> fromImportLocation loc