optimisation for transfers to drives that are not plugged in
Rather than forking a git-annex transferkey only to have it fail, just immediately record the failed transfer (so when the drive is plugged in, the scan will retry it).
This commit is contained in:
parent
4ce25e8986
commit
b543842a7f
2 changed files with 25 additions and 15 deletions
|
@ -18,6 +18,8 @@ import Logs.Transfer
|
|||
import Logs.Location
|
||||
import Annex.Content
|
||||
import qualified Remote
|
||||
import qualified Types.Remote as Remote
|
||||
import qualified Git
|
||||
import Types.Key
|
||||
import Locations.UserConfig
|
||||
import Assistant.Threads.TransferWatcher
|
||||
|
@ -44,18 +46,24 @@ startTransfer
|
|||
-> TransferInfo
|
||||
-> Assistant (Maybe (Transfer, TransferInfo, Assistant ()))
|
||||
startTransfer program t info = case (transferRemote info, associatedFile info) of
|
||||
(Just remote, Just file) -> ifM (liftAnnex $ shouldTransfer t info)
|
||||
( do
|
||||
debug [ "Transferring:" , describeTransfer t info ]
|
||||
notifyTransfer
|
||||
return $ Just (t, info, transferprocess remote file)
|
||||
, do
|
||||
debug [ "Skipping unnecessary transfer:",
|
||||
describeTransfer t info ]
|
||||
(Just remote, Just file)
|
||||
| Git.repoIsLocalUnknown (Remote.repo remote) -> do
|
||||
-- optimisation for removable drives not plugged in
|
||||
liftAnnex $ recordFailedTransfer t info
|
||||
void $ removeTransfer t
|
||||
finishedTransfer t (Just info)
|
||||
return Nothing
|
||||
)
|
||||
| otherwise -> ifM (liftAnnex $ shouldTransfer t info)
|
||||
( do
|
||||
debug [ "Transferring:" , describeTransfer t info ]
|
||||
notifyTransfer
|
||||
return $ Just (t, info, transferprocess remote file)
|
||||
, do
|
||||
debug [ "Skipping unnecessary transfer:",
|
||||
describeTransfer t info ]
|
||||
void $ removeTransfer t
|
||||
finishedTransfer t (Just info)
|
||||
return Nothing
|
||||
)
|
||||
_ -> return Nothing
|
||||
where
|
||||
direction = transferDirection t
|
||||
|
|
|
@ -115,7 +115,7 @@ runTransfer t file shouldretry a = do
|
|||
mode <- annexFileMode
|
||||
ok <- retry info metervar $
|
||||
bracketIO (prep tfile mode info) (cleanup tfile) (a meter)
|
||||
unless ok $ failed info
|
||||
unless ok $ recordFailedTransfer t info
|
||||
return ok
|
||||
where
|
||||
prep tfile mode info = catchMaybeIO $ do
|
||||
|
@ -132,10 +132,6 @@ runTransfer t file shouldretry a = do
|
|||
void $ tryIO $ removeFile tfile
|
||||
void $ tryIO $ removeFile $ transferLockFile tfile
|
||||
closeFd fd
|
||||
failed info = do
|
||||
failedtfile <- fromRepo $ failedTransferFile t
|
||||
createAnnexDirectory $ takeDirectory failedtfile
|
||||
liftIO $ writeTransferInfoFile info failedtfile
|
||||
retry oldinfo metervar run = do
|
||||
v <- tryAnnex run
|
||||
case v of
|
||||
|
@ -236,6 +232,12 @@ removeFailedTransfer t = do
|
|||
f <- fromRepo $ failedTransferFile t
|
||||
liftIO $ void $ tryIO $ removeFile f
|
||||
|
||||
recordFailedTransfer :: Transfer -> TransferInfo -> Annex ()
|
||||
recordFailedTransfer t info = do
|
||||
failedtfile <- fromRepo $ failedTransferFile t
|
||||
createAnnexDirectory $ takeDirectory failedtfile
|
||||
liftIO $ writeTransferInfoFile info failedtfile
|
||||
|
||||
{- The transfer information file to use for a given Transfer. -}
|
||||
transferFile :: Transfer -> Git.Repo -> FilePath
|
||||
transferFile (Transfer direction u key) r = transferDir direction r
|
||||
|
|
Loading…
Add table
Reference in a new issue