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.
-> 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
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'
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
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
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
, 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
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)
, 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
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"
, "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 =
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
- 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 []
| 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
+++ /dev/null
-{- Helpers for thirdPartyPopulated remotes
- -
- - Copyright 2020 Joey Hess <id@joeyh.name>
- -
- - Licensed under the GNU AGPL version 3 or higher.
- -}
-
-module Remote.Helper.ThirdParty where
-
-import Annex.Common
-import Types.Remote
-import Types.Import
-import Crypto (isEncKey)
-import Utility.Metered
-
-import qualified System.FilePath.ByteString as P
-
--- When a remote is thirdPartyPopulated, and contains a backup of a
--- git-annex repository or some special remotes, this can be used to
--- 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 $ case deserializeKey' 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
- -- that was backed up, it is probably not a valid annex object.
- -- Eg, it could be something in annex/bad/, or annex/tmp/.
- -- Or it could be a file that only happens to have a name
- -- like an annex object.
- -- (This does unfortunately prevent recognizing files that are
- -- part of special remotes that don't use that layout. The most
- -- likely special remote to be in a backup, the directory
- -- special remote, does use that layout at least.)
- | lastMaybe (P.splitDirectories (P.dropFileName p)) /= Just f -> Nothing
- -- Chunked or encrypted keys used in special remotes are not
- -- supported.
- | isChunkKey k || isEncKey k -> Nothing
- -- Check that the size of the key is the same as the size of the
- -- file stored in the backup. This is a cheap way to make sure it's
- -- probabably the actual content of the file. We don't fully
- -- verify the content here because that could be a very
- -- expensive operation for a large repository; if the user
- -- wants to detect every possible data corruption problem
- -- (eg, wrong data read off disk during backup, or the object
- -- was corrupt in the git-annex repo and that bad object got
- -- backed up), they can fsck the remote.
- | otherwise -> case fromKey keySize k of
- Just sz'
- | sz' == sz -> Just k
- | otherwise -> Nothing
- Nothing -> Just k
- Nothing -> Nothing
- where
- p = fromImportLocation loc
- f = P.takeFileName p
--- /dev/null
+{- Helpers for thirdPartyPopulated remotes
+ -
+ - Copyright 2020 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU AGPL version 3 or higher.
+ -}
+
+module Remote.Helper.ThirdParty where
+
+import Annex.Common
+import Types.Remote
+import Types.Import
+import Crypto (isEncKey)
+import Utility.Metered
+
+import qualified System.FilePath.ByteString as P
+
+-- When a remote is thirdPartyPopulated, and contains a backup of a
+-- git-annex repository or some special remotes, this can be used to
+-- 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 $ case deserializeKey' 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
+ -- that was backed up, it is probably not a valid annex object.
+ -- Eg, it could be something in annex/bad/, or annex/tmp/.
+ -- Or it could be a file that only happens to have a name
+ -- like an annex object.
+ -- (This does unfortunately prevent recognizing files that are
+ -- part of special remotes that don't use that layout. The most
+ -- likely special remote to be in a backup, the directory
+ -- special remote, does use that layout at least.)
+ | lastMaybe (P.splitDirectories (P.dropFileName p)) /= Just f -> Nothing
+ -- Chunked or encrypted keys used in special remotes are not
+ -- supported.
+ | isChunkKey k || isEncKey k -> Nothing
+ -- Check that the size of the key is the same as the size of the
+ -- file stored in the backup. This is a cheap way to make sure it's
+ -- probabably the actual content of the file. We don't fully
+ -- verify the content here because that could be a very
+ -- expensive operation for a large repository; if the user
+ -- wants to detect every possible data corruption problem
+ -- (eg, wrong data read off disk during backup, or the object
+ -- was corrupt in the git-annex repo and that bad object got
+ -- backed up), they can fsck the remote.
+ | otherwise -> case fromKey keySize k of
+ Just sz'
+ | sz' == sz -> Just k
+ | otherwise -> Nothing
+ Nothing -> Just k
+ Nothing -> Nothing
+ where
+ p = fromImportLocation loc
+ f = P.takeFileName p
projects / git-annex.git / commitdiff