add additional debug info about reasons for drops

This commit is contained in:
Joey Hess 2013-03-01 15:58:44 -04:00
parent 3c9cb4f05b
commit a733271a9c
5 changed files with 40 additions and 24 deletions

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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