tweak
This commit is contained in:
parent
f39dc54644
commit
60760cb430
2 changed files with 15 additions and 8 deletions
|
@ -35,9 +35,13 @@ transfererThread = namedThread "Transferrer" $ do
|
||||||
{- Skip transfers that are already running. -}
|
{- Skip transfers that are already running. -}
|
||||||
notrunning = isNothing . startedTime
|
notrunning = isNothing . startedTime
|
||||||
|
|
||||||
{- By the time this is called, the daemonstatus's transfer map should
|
{- By the time this is called, the daemonstatus's currentTransfers map should
|
||||||
- already have been updated to include the transfer. -}
|
- already have been updated to include the transfer. -}
|
||||||
startTransfer :: FilePath -> Transfer -> TransferInfo -> Assistant (Maybe (Transfer, TransferInfo, Assistant ()))
|
startTransfer
|
||||||
|
:: FilePath
|
||||||
|
-> Transfer
|
||||||
|
-> TransferInfo
|
||||||
|
-> 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) -> ifM (liftAnnex $ shouldTransfer t info)
|
||||||
( do
|
( do
|
||||||
|
@ -45,7 +49,8 @@ startTransfer program t info = case (transferRemote info, associatedFile info) o
|
||||||
notifyTransfer
|
notifyTransfer
|
||||||
return $ Just (t, info, transferprocess remote file)
|
return $ Just (t, info, transferprocess remote file)
|
||||||
, do
|
, do
|
||||||
debug [ "Skipping unnecessary transfer:" , describeTransfer t info ]
|
debug [ "Skipping unnecessary transfer:",
|
||||||
|
describeTransfer t info ]
|
||||||
void $ removeTransfer t
|
void $ removeTransfer t
|
||||||
finishedTransfer t (Just info)
|
finishedTransfer t (Just info)
|
||||||
return Nothing
|
return Nothing
|
||||||
|
@ -57,7 +62,8 @@ startTransfer program t info = case (transferRemote info, associatedFile info) o
|
||||||
|
|
||||||
transferprocess remote file = void $ do
|
transferprocess remote file = void $ do
|
||||||
(_, _, _, pid)
|
(_, _, _, pid)
|
||||||
<- liftIO $ createProcess (proc program $ toCommand params)
|
<- liftIO $ createProcess
|
||||||
|
(proc program $ toCommand params)
|
||||||
{ create_group = True }
|
{ create_group = True }
|
||||||
{- Alerts are only shown for successful transfers.
|
{- Alerts are only shown for successful transfers.
|
||||||
- Transfers can temporarily fail for many reasons,
|
- Transfers can temporarily fail for many reasons,
|
||||||
|
|
|
@ -58,14 +58,14 @@ queueTransfersMatching matching reason schedule k f direction
|
||||||
| otherwise = go
|
| otherwise = go
|
||||||
where
|
where
|
||||||
go = do
|
go = do
|
||||||
rs <- liftAnnex . sufficientremotes
|
rs <- liftAnnex . selectremotes
|
||||||
=<< syncDataRemotes <$> getDaemonStatus
|
=<< syncDataRemotes <$> getDaemonStatus
|
||||||
let matchingrs = filter (matching . Remote.uuid) rs
|
let matchingrs = filter (matching . Remote.uuid) rs
|
||||||
if null matchingrs
|
if null matchingrs
|
||||||
then defer
|
then defer
|
||||||
else forM_ matchingrs $ \r ->
|
else forM_ matchingrs $ \r ->
|
||||||
enqueue reason schedule (gentransfer r) (stubInfo f r)
|
enqueue reason schedule (gentransfer r) (stubInfo f r)
|
||||||
sufficientremotes rs
|
selectremotes rs
|
||||||
{- Queue downloads from all remotes that
|
{- Queue downloads from all remotes that
|
||||||
- have the key, with the cheapest ones first.
|
- have the key, with the cheapest ones first.
|
||||||
- More expensive ones will only be tried if
|
- More expensive ones will only be tried if
|
||||||
|
@ -107,7 +107,8 @@ queueDeferredDownloads reason schedule = do
|
||||||
let sources = filter (\r -> uuid r `elem` uuids) rs
|
let sources = filter (\r -> uuid r `elem` uuids) rs
|
||||||
unless (null sources) $
|
unless (null sources) $
|
||||||
forM_ sources $ \r ->
|
forM_ sources $ \r ->
|
||||||
enqueue reason schedule (gentransfer r) (stubInfo f r)
|
enqueue reason schedule
|
||||||
|
(gentransfer r) (stubInfo f r)
|
||||||
return $ null sources
|
return $ null sources
|
||||||
where
|
where
|
||||||
gentransfer r = Transfer
|
gentransfer r = Transfer
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue