add additional debug info about reasons for drops
This commit is contained in:
parent
3c9cb4f05b
commit
a733271a9c
5 changed files with 40 additions and 24 deletions
|
@ -115,12 +115,12 @@ expensiveScan rs = unless onlyweb $ do
|
|||
{- The syncable remotes may have changed since this
|
||||
- scan began. -}
|
||||
syncrs <- syncDataRemotes <$> getDaemonStatus
|
||||
locs <- liftAnnex $ loggedLocations key
|
||||
present <- liftAnnex $ inAnnex key
|
||||
handleDropsFrom locs syncrs
|
||||
"expensive scan found too many copies of object"
|
||||
present key (Just f) Nothing
|
||||
liftAnnex $ do
|
||||
locs <- loggedLocations key
|
||||
present <- inAnnex key
|
||||
|
||||
handleDropsFrom locs syncrs present key (Just f) Nothing
|
||||
|
||||
let slocs = S.fromList locs
|
||||
let use a = return $ catMaybes $ map (a key slocs) syncrs
|
||||
if present
|
||||
|
|
|
@ -115,10 +115,14 @@ finishedTransfer :: Transfer -> Maybe TransferInfo -> Assistant ()
|
|||
finishedTransfer t (Just info)
|
||||
| transferDirection t == Download =
|
||||
whenM (liftAnnex $ inAnnex $ transferKey t) $ do
|
||||
handleDrops False (transferKey t) (associatedFile info) Nothing
|
||||
dodrops False
|
||||
queueTransfersMatching (/= transferUUID t)
|
||||
"newly received object"
|
||||
Later (transferKey t) (associatedFile info) Upload
|
||||
| otherwise = handleDrops True (transferKey t) (associatedFile info) Nothing
|
||||
| otherwise = dodrops True
|
||||
where
|
||||
dodrops fromhere = handleDrops
|
||||
("drop wanted after " ++ describeTransfer t info)
|
||||
fromhere (transferKey t) (associatedFile info) Nothing
|
||||
finishedTransfer _ _ = noop
|
||||
|
||||
|
|
|
@ -76,7 +76,9 @@ startTransfer program t info = case (transferRemote info, associatedFile info) o
|
|||
void $ addAlert $ makeAlertFiller True $
|
||||
transferFileAlert direction True file
|
||||
unless isdownload $
|
||||
handleDrops True (transferKey t)
|
||||
handleDrops
|
||||
("object uploaded to " ++ show remote)
|
||||
True (transferKey t)
|
||||
(associatedFile info)
|
||||
(Just remote)
|
||||
recordCommit
|
||||
|
|
|
@ -254,7 +254,7 @@ onAddSymlink file filestatus = go =<< liftAnnex (Backend.lookupFile file)
|
|||
if present
|
||||
then queueTransfers "new file created" Next key (Just file) Upload
|
||||
else queueTransfers "new or renamed file wanted" Next key (Just file) Download
|
||||
handleDrops present key (Just file) Nothing
|
||||
handleDrops "file renamed" present key (Just file) Nothing
|
||||
| otherwise = noop
|
||||
|
||||
onDel :: Handler
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue