improve thirdpartypopulated support
May actually work now. Note that, importKey now has to add the size to the key if it's supposed to have size. Remote.Directory relied on the importer adding the size, which is no longer done, so it was changed; it was the only one. This way, importKey does not need to behave differently between regular and thirdpartypopulated imports.
This commit is contained in:
Joey Hess
parent
57b03630b3
commit
15000dee07
5 changed files with 56 additions and 50 deletions
|
|
@ -325,7 +325,7 @@ importKeys
|
|||
-> Bool
|
||||
-> ImportableContents (ContentIdentifier, ByteSize)
|
||||
-> Annex (Maybe (ImportableContents (Either Sha Key)))
|
||||
importKeys remote importtreeconfig importcontent ignorelargefilesconfig importablecontents = do
|
||||
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
|
||||
|
|
@ -347,7 +347,9 @@ importKeys remote importtreeconfig importcontent ignorelargefilesconfig importab
|
|||
go oldversion cidmap importing (ImportableContents l h) db = do
|
||||
largematcher <- largeFilesMatcher
|
||||
jobs <- forM l $ \i ->
|
||||
startimport cidmap importing db i oldversion largematcher
|
||||
if thirdpartypopulated
|
||||
then thirdpartypopulatedimport cidmap db i
|
||||
else startimport cidmap importing db i oldversion largematcher
|
||||
l' <- liftIO $ forM jobs $
|
||||
either pure (atomically . takeTMVar)
|
||||
if any isNothing l'
|
||||
|
|
@ -406,6 +408,20 @@ importKeys remote importtreeconfig importcontent ignorelargefilesconfig importab
|
|||
importaction
|
||||
return (Right job)
|
||||
|
||||
thirdpartypopulatedimport cidmap db (loc, (cid, sz)) =
|
||||
case Remote.importKey ia of
|
||||
Nothing -> return $ Left 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
|
||||
Left e -> do
|
||||
warning (show e)
|
||||
return $ Left Nothing
|
||||
|
||||
importordownload cidmap db (loc, (cid, sz)) largematcher= do
|
||||
f <- locworktreefile loc
|
||||
matcher <- largematcher f
|
||||
|
|
@ -415,7 +431,7 @@ importKeys remote importtreeconfig importcontent ignorelargefilesconfig importab
|
|||
let act = if importcontent
|
||||
then case Remote.importKey ia of
|
||||
Nothing -> dodownload
|
||||
Just _ -> if not ignorelargefilesconfig && Utility.Matcher.introspect matchNeedsFileContent matcher
|
||||
Just _ -> if Utility.Matcher.introspect matchNeedsFileContent matcher
|
||||
then dodownload
|
||||
else doimport
|
||||
else doimport
|
||||
|
|
@ -425,7 +441,7 @@ importKeys remote importtreeconfig importcontent ignorelargefilesconfig importab
|
|||
case Remote.importKey ia of
|
||||
Nothing -> error "internal" -- checked earlier
|
||||
Just importkey -> do
|
||||
when (not ignorelargefilesconfig && Utility.Matcher.introspect matchNeedsFileContent matcher) $
|
||||
when (Utility.Matcher.introspect matchNeedsFileContent matcher) $
|
||||
giveup "annex.largefiles configuration examines file contents, so cannot import without content."
|
||||
let mi = MatchingInfo ProvidedInfo
|
||||
{ providedFilePath = f
|
||||
|
|
@ -434,9 +450,7 @@ importKeys remote importtreeconfig importcontent ignorelargefilesconfig importab
|
|||
, providedMimeType = Nothing
|
||||
, providedMimeEncoding = Nothing
|
||||
}
|
||||
islargefile <- if ignorelargefilesconfig
|
||||
then pure True
|
||||
else checkMatcher' matcher mi mempty
|
||||
islargefile <- checkMatcher' matcher mi mempty
|
||||
metered Nothing sz $ const $ if islargefile
|
||||
then doimportlarge importkey cidmap db loc cid sz f
|
||||
else doimportsmall cidmap db loc cid sz
|
||||
|
|
@ -457,20 +471,15 @@ importKeys remote importtreeconfig importcontent ignorelargefilesconfig importab
|
|||
let p' = if importcontent then nullMeterUpdate else p
|
||||
importkey loc cid sz p' >>= \case
|
||||
Nothing -> return Nothing
|
||||
Just unsizedk -> do
|
||||
-- This avoids every remote needing
|
||||
-- to add the size.
|
||||
let k = alterKey unsizedk $ \kd -> kd
|
||||
{ keySize = keySize kd <|> Just sz }
|
||||
checkSecureHashes k >>= \case
|
||||
Nothing -> do
|
||||
recordcidkey cidmap db cid k
|
||||
logChange k (Remote.uuid remote) InfoPresent
|
||||
if importcontent
|
||||
then getcontent k
|
||||
else return (Just (k, True))
|
||||
Just msg -> giveup (msg ++ " to import")
|
||||
|
||||
Just k -> checkSecureHashes k >>= \case
|
||||
Nothing -> do
|
||||
recordcidkey cidmap db 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)
|
||||
|
|
@ -552,9 +561,7 @@ importKeys remote importtreeconfig importcontent ignorelargefilesconfig importab
|
|||
, contentFile = Just tmpfile
|
||||
, matchKey = Nothing
|
||||
}
|
||||
islargefile <- if ignorelargefilesconfig
|
||||
then pure True
|
||||
else checkMatcher' matcher mi mempty
|
||||
islargefile <- checkMatcher' matcher mi mempty
|
||||
if islargefile
|
||||
then do
|
||||
backend <- chooseBackend f
|
||||
|
|
|
|||
|
|
@ -324,11 +324,18 @@ seekRemote remote branch msubdir importcontent ci = do
|
|||
|
||||
listContents :: Remote -> ImportTreeConfig -> CheckGitIgnore -> TVar (Maybe (ImportableContents (ContentIdentifier, Remote.ByteSize))) -> CommandStart
|
||||
listContents remote importtreeconfig ci tvar = starting "list" ai si $
|
||||
listContents' remote importtreeconfig ci $ \importable -> do
|
||||
liftIO $ atomically $ writeTVar tvar (Just importable)
|
||||
next $ return True
|
||||
where
|
||||
ai = ActionItemOther (Just (Remote.name remote))
|
||||
si = SeekInput []
|
||||
|
||||
listContents' :: Remote -> ImportTreeConfig -> CheckGitIgnore -> (ImportableContents (ContentIdentifier, Remote.ByteSize) -> Annex a) -> Annex a
|
||||
listContents' remote importtreeconfig ci a =
|
||||
makeImportMatcher remote >>= \case
|
||||
Right matcher -> getImportableContents remote importtreeconfig ci matcher >>= \case
|
||||
Just importable -> next $ do
|
||||
liftIO $ atomically $ writeTVar tvar (Just importable)
|
||||
return True
|
||||
Just importable -> a importable
|
||||
Nothing -> giveup $ "Unable to list contents of " ++ Remote.name remote
|
||||
Left err -> giveup $ unwords
|
||||
[ "Cannot import from"
|
||||
|
|
@ -336,9 +343,6 @@ listContents remote importtreeconfig ci tvar = starting "list" ai si $
|
|||
, "because of a problem with its configuration:"
|
||||
, err
|
||||
]
|
||||
where
|
||||
ai = ActionItemOther (Just (Remote.name remote))
|
||||
si = SeekInput []
|
||||
|
||||
commitRemote :: Remote -> Branch -> RemoteTrackingBranch -> Maybe Sha -> ImportTreeConfig -> ImportCommitConfig -> ImportableContents (Either Sha Key) -> CommandStart
|
||||
commitRemote remote branch tb trackingcommit importtreeconfig importcommitconfig importable =
|
||||
|
|
|
|||
|
|
@ -77,7 +77,6 @@ import Utility.Process.Transcript
|
|||
import Utility.Tuple
|
||||
|
||||
import Control.Concurrent.MVar
|
||||
import Control.Concurrent.STM
|
||||
import qualified Data.Map as M
|
||||
import qualified Data.ByteString as S
|
||||
import Data.Char
|
||||
|
|
@ -492,24 +491,18 @@ importRemote importcontent o mergeconfig remote currbranch
|
|||
- updated, because the filenames are the names of annex object files,
|
||||
- not suitable for a tracking branch. Does not transfer any content. -}
|
||||
importThirdPartyPopulated :: Remote -> CommandSeek
|
||||
importThirdPartyPopulated remote = do
|
||||
importabletvar <- liftIO $ newTVarIO Nothing
|
||||
void $ includeCommandAction (Command.Import.listContents remote ImportTree (CheckGitIgnore False) importabletvar)
|
||||
liftIO (atomically (readTVar importabletvar)) >>= \case
|
||||
Nothing -> return ()
|
||||
Just importable ->
|
||||
importKeys remote ImportTree False False importable >>= \case
|
||||
Just importablekeys -> go importablekeys
|
||||
Nothing -> warning $ concat
|
||||
[ "Failed to import from"
|
||||
, Remote.name remote
|
||||
]
|
||||
importThirdPartyPopulated remote =
|
||||
void $ includeCommandAction $ starting "list" ai si $
|
||||
Command.Import.listContents' remote ImportTree (CheckGitIgnore False) go
|
||||
where
|
||||
go importablekeys = void $ includeCommandAction $ starting "pull" ai si $ do
|
||||
(_imported, updatestate) <- recordImportTree remote ImportTree importablekeys
|
||||
next $ do
|
||||
updatestate
|
||||
return True
|
||||
go importable = importKeys remote ImportTree False True importable >>= \case
|
||||
Just importablekeys -> do
|
||||
(_imported, updatestate) <- recordImportTree remote ImportTree importablekeys
|
||||
next $ do
|
||||
updatestate
|
||||
return True
|
||||
Nothing -> next $ return False
|
||||
|
||||
ai = ActionItemOther (Just (Remote.name remote))
|
||||
si = SeekInput []
|
||||
|
||||
|
|
|
|||
|
|
@ -371,9 +371,11 @@ guardSameContentIdentifiers cont old new
|
|||
| otherwise = giveup "file content has changed"
|
||||
|
||||
importKeyM :: RawFilePath -> ExportLocation -> ContentIdentifier -> ByteSize -> MeterUpdate -> Annex (Maybe Key)
|
||||
importKeyM dir loc cid _sz p = do
|
||||
importKeyM dir loc cid sz p = do
|
||||
backend <- chooseBackend f
|
||||
k <- fst <$> genKey ks p backend
|
||||
unsizedk <- fst <$> genKey ks p backend
|
||||
let k = alterKey unsizedk $ \kd -> kd
|
||||
{ keySize = keySize kd <|> Just sz }
|
||||
currcid <- liftIO $ mkContentIdentifier absf
|
||||
=<< R.getFileStatus absf
|
||||
guardSameContentIdentifiers (return (Just k)) cid currcid
|
||||
|
|
|
|||
Loading…
Reference in a new issue