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 Logs.Location
|
||||||
import Annex.Content
|
import Annex.Content
|
||||||
import qualified Remote
|
import qualified Remote
|
||||||
|
import qualified Types.Remote as Remote
|
||||||
|
import qualified Git
|
||||||
import Types.Key
|
import Types.Key
|
||||||
import Locations.UserConfig
|
import Locations.UserConfig
|
||||||
import Assistant.Threads.TransferWatcher
|
import Assistant.Threads.TransferWatcher
|
||||||
|
@ -44,18 +46,24 @@ startTransfer
|
||||||
-> TransferInfo
|
-> TransferInfo
|
||||||
-> Assistant (Maybe (Transfer, TransferInfo, Assistant ()))
|
-> Assistant (Maybe (Transfer, TransferInfo, Assistant ()))
|
||||||
startTransfer program t info = case (transferRemote info, associatedFile info) of
|
startTransfer program t info = case (transferRemote info, associatedFile info) of
|
||||||
(Just remote, Just file) -> ifM (liftAnnex $ shouldTransfer t info)
|
(Just remote, Just file)
|
||||||
( do
|
| Git.repoIsLocalUnknown (Remote.repo remote) -> do
|
||||||
debug [ "Transferring:" , describeTransfer t info ]
|
-- optimisation for removable drives not plugged in
|
||||||
notifyTransfer
|
liftAnnex $ recordFailedTransfer t info
|
||||||
return $ Just (t, info, transferprocess remote file)
|
|
||||||
, do
|
|
||||||
debug [ "Skipping unnecessary transfer:",
|
|
||||||
describeTransfer t info ]
|
|
||||||
void $ removeTransfer t
|
void $ removeTransfer t
|
||||||
finishedTransfer t (Just info)
|
|
||||||
return Nothing
|
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
|
_ -> return Nothing
|
||||||
where
|
where
|
||||||
direction = transferDirection t
|
direction = transferDirection t
|
||||||
|
|
|
@ -115,7 +115,7 @@ runTransfer t file shouldretry a = do
|
||||||
mode <- annexFileMode
|
mode <- annexFileMode
|
||||||
ok <- retry info metervar $
|
ok <- retry info metervar $
|
||||||
bracketIO (prep tfile mode info) (cleanup tfile) (a meter)
|
bracketIO (prep tfile mode info) (cleanup tfile) (a meter)
|
||||||
unless ok $ failed info
|
unless ok $ recordFailedTransfer t info
|
||||||
return ok
|
return ok
|
||||||
where
|
where
|
||||||
prep tfile mode info = catchMaybeIO $ do
|
prep tfile mode info = catchMaybeIO $ do
|
||||||
|
@ -132,10 +132,6 @@ runTransfer t file shouldretry a = do
|
||||||
void $ tryIO $ removeFile tfile
|
void $ tryIO $ removeFile tfile
|
||||||
void $ tryIO $ removeFile $ transferLockFile tfile
|
void $ tryIO $ removeFile $ transferLockFile tfile
|
||||||
closeFd fd
|
closeFd fd
|
||||||
failed info = do
|
|
||||||
failedtfile <- fromRepo $ failedTransferFile t
|
|
||||||
createAnnexDirectory $ takeDirectory failedtfile
|
|
||||||
liftIO $ writeTransferInfoFile info failedtfile
|
|
||||||
retry oldinfo metervar run = do
|
retry oldinfo metervar run = do
|
||||||
v <- tryAnnex run
|
v <- tryAnnex run
|
||||||
case v of
|
case v of
|
||||||
|
@ -236,6 +232,12 @@ removeFailedTransfer t = do
|
||||||
f <- fromRepo $ failedTransferFile t
|
f <- fromRepo $ failedTransferFile t
|
||||||
liftIO $ void $ tryIO $ removeFile f
|
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. -}
|
{- The transfer information file to use for a given Transfer. -}
|
||||||
transferFile :: Transfer -> Git.Repo -> FilePath
|
transferFile :: Transfer -> Git.Repo -> FilePath
|
||||||
transferFile (Transfer direction u key) r = transferDir direction r
|
transferFile (Transfer direction u key) r = transferDir direction r
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue