keep logs of failed transfers, and requeue them when doing a non-full scan

of a remote
This commit is contained in:
Joey Hess 2012-08-23 15:22:23 -04:00
parent 487bdf0e24
commit 715a9a2f8e
9 changed files with 132 additions and 64 deletions

View file

@ -135,13 +135,12 @@ fromPerform :: Remote -> Bool -> Key -> FilePath -> CommandPerform
fromPerform src move key file = moveLock move key $
ifM (inAnnex key)
( handle move True
, download (Remote.uuid src) key (Just file) $ do
showAction $ "from " ++ Remote.name src
ok <- getViaTmp key $
Remote.retrieveKeyFile src key (Just file)
handle move ok
, handle move =<< go
)
where
go = download (Remote.uuid src) key (Just file) $ do
showAction $ "from " ++ Remote.name src
getViaTmp key $ Remote.retrieveKeyFile src key (Just file)
handle _ False = stop -- failed
handle False True = next $ return True -- copy complete
handle True True = do -- finish moving

View file

@ -13,6 +13,7 @@ import CmdLine
import Annex.Content
import Utility.RsyncFile
import Logs.Transfer
import Command.SendKey (fieldTransfer)
def :: [Command]
def = [oneShot $ command "recvkey" paramKey seek
@ -30,7 +31,7 @@ start key = ifM (inAnnex key)
-- forcibly quit after receiving one key,
-- and shutdown cleanly
_ <- shutdown True
liftIO exitSuccess
, liftIO exitFailure
return True
, return False
)
)

View file

@ -12,6 +12,7 @@ import Command
import Annex.Content
import Utility.RsyncFile
import Logs.Transfer
import qualified Fields
def :: [Command]
def = [oneShot $ command "sendkey" paramKey seek
@ -24,9 +25,17 @@ start :: Key -> CommandStart
start key = ifM (inAnnex key)
( fieldTransfer Upload key $ do
file <- inRepo $ gitAnnexLocation key
liftIO $ ifM (rsyncServerSend file)
( exitSuccess , exitFailure )
liftIO $ rsyncServerSend file
, do
warning "requested key is not present"
liftIO exitFailure
)
fieldTransfer :: Direction -> Key -> Annex Bool -> CommandStart
fieldTransfer direction key a = do
afile <- Fields.getField Fields.associatedFile
ok <- maybe a (\u -> runTransfer (Transfer direction (toUUID u) key) afile a)
=<< Fields.getField Fields.remoteUUID
if ok
then liftIO exitSuccess
else liftIO exitFailure