sync: When listing contents on an import remote fails, proceed with other syncing instead of aborting

Switch listContents to being a proper CommandStart, so if it throws an
exception, it will be treated like any other command action that fails.

downloadImport apparently does not ever throw an exception,
and itself uses commandAction, so it can't be a CommandStart.
This commit is contained in:
Joey Hess 2019-04-10 17:02:56 -04:00
parent 3d6f1b7dba
commit f95f340c73
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
3 changed files with 27 additions and 19 deletions

View file

@ -214,8 +214,8 @@ buildImportTrees basetree msubdir importable = History
{- Downloads all new ContentIdentifiers as needed to generate Keys. {- Downloads all new ContentIdentifiers as needed to generate Keys.
- Supports concurrency when enabled. - Supports concurrency when enabled.
- -
- If any download fails, the whole thing fails, but it will resume where - If any download fails, the whole thing fails with Nothing,
- it left off. - but it will resume where it left off.
-} -}
downloadImport :: Remote -> ImportTreeConfig -> ImportableContents (ContentIdentifier, ByteSize) -> Annex (Maybe (ImportableContents Key)) downloadImport :: Remote -> ImportTreeConfig -> ImportableContents (ContentIdentifier, ByteSize) -> Annex (Maybe (ImportableContents Key))
downloadImport remote importtreeconfig importablecontents = do downloadImport remote importtreeconfig importablecontents = do

View file

@ -9,6 +9,8 @@ git-annex (7.20190323) UNRELEASED; urgency=medium
content. content.
* Made git-annex sync --content much faster when all the remotes it's * Made git-annex sync --content much faster when all the remotes it's
syncing with are export/import remotes. syncing with are export/import remotes.
* sync: When listing contents on an import remote fails, proceed with
other syncing instead of aborting.
-- Joey Hess <id@joeyh.name> Tue, 09 Apr 2019 14:07:53 -0400 -- Joey Hess <id@joeyh.name> Tue, 09 Apr 2019 14:07:53 -0400

View file

@ -33,6 +33,8 @@ import Git.Types
import Git.Branch import Git.Branch
import Types.Import import Types.Import
import Control.Concurrent.STM
cmd :: Command cmd :: Command
cmd = notBareRepo $ cmd = notBareRepo $
withGlobalOptions [jobsOption, jsonOptions, fileMatchingOptions] $ withGlobalOptions [jobsOption, jsonOptions, fileMatchingOptions] $
@ -265,10 +267,20 @@ seekRemote remote branch msubdir = do
parentcommit <- fromtrackingbranch Git.Ref.sha parentcommit <- fromtrackingbranch Git.Ref.sha
let importcommitconfig = ImportCommitConfig parentcommit ManualCommit importmessage let importcommitconfig = ImportCommitConfig parentcommit ManualCommit importmessage
let commitimport = commitRemote remote branch tb parentcommit importtreeconfig importcommitconfig
importable <- download importtreeconfig =<< listcontents importabletvar <- liftIO $ newTVarIO Nothing
void $ includeCommandAction $ void $ includeCommandAction (listContents remote importabletvar)
commitRemote remote branch tb parentcommit importtreeconfig importcommitconfig importable liftIO (atomically (readTVar importabletvar)) >>= \case
Nothing -> return ()
Just importable -> downloadImport remote importtreeconfig importable >>= \case
Nothing -> warning $ concat
[ "Failed to import some files from "
, Remote.name remote
, ". Re-run command to resume import."
]
Just imported -> void $
includeCommandAction $ commitimport imported
where where
importmessage = "import from " ++ Remote.name remote importmessage = "import from " ++ Remote.name remote
@ -276,20 +288,14 @@ seekRemote remote branch msubdir = do
fromtrackingbranch a = inRepo $ a (fromRemoteTrackingBranch tb) fromtrackingbranch a = inRepo $ a (fromRemoteTrackingBranch tb)
listcontents = do listContents :: Remote -> TVar (Maybe (ImportableContents (ContentIdentifier, Remote.ByteSize))) -> CommandStart
listContents remote tvar = do
showStart' "list" (Just (Remote.name remote)) showStart' "list" (Just (Remote.name remote))
Remote.listImportableContents (Remote.importActions remote) >>= \case next $ Remote.listImportableContents (Remote.importActions remote) >>= \case
Nothing -> do Nothing -> giveup $ "Unable to list contents of " ++ Remote.name remote
showEndFail Just importable -> next $ do
giveup $ "Unable to list contents of " ++ Remote.name remote liftIO $ atomically $ writeTVar tvar (Just importable)
Just importable -> do return True
showEndOk
return importable
download importtreeconfig importablecontents =
downloadImport remote importtreeconfig importablecontents >>= \case
Nothing -> giveup $ "Failed to import some files from " ++ Remote.name remote ++ ". Re-run command to resume import."
Just importable -> return importable
commitRemote :: Remote -> Branch -> RemoteTrackingBranch -> Maybe Sha -> ImportTreeConfig -> ImportCommitConfig -> ImportableContents Key -> CommandStart commitRemote :: Remote -> Branch -> RemoteTrackingBranch -> Maybe Sha -> ImportTreeConfig -> ImportCommitConfig -> ImportableContents Key -> CommandStart
commitRemote remote branch tb parentcommit importtreeconfig importcommitconfig importable = do commitRemote remote branch tb parentcommit importtreeconfig importcommitconfig importable = do