improve "unable to lock down 1 copy" message

This is a fairly hard to understand situation for the user. Listing the
remotes should help them understand it a bit better.

This commit was sponsored by Ethan Aubin.
This commit is contained in:
Joey Hess 2020-06-26 13:00:40 -04:00
parent 7203353e24
commit a59e95a82d
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
2 changed files with 25 additions and 16 deletions

View file

@ -124,28 +124,29 @@ verifyEnoughCopiesToDrop
-> Annex a -- action to perform when unable to drop -> Annex a -- action to perform when unable to drop
-> Annex a -> Annex a
verifyEnoughCopiesToDrop nolocmsg key removallock need skip preverified tocheck dropaction nodropaction = verifyEnoughCopiesToDrop nolocmsg key removallock need skip preverified tocheck dropaction nodropaction =
helper [] [] preverified (nub tocheck) helper [] [] preverified (nub tocheck) []
where where
helper bad missing have [] = helper bad missing have [] lockunsupported =
liftIO (mkSafeDropProof need have removallock) >>= \case liftIO (mkSafeDropProof need have removallock) >>= \case
Right proof -> dropaction proof Right proof -> dropaction proof
Left stillhave -> do Left stillhave -> do
notEnoughCopies key need stillhave (skip++missing) bad nolocmsg notEnoughCopies key need stillhave (skip++missing) bad nolocmsg lockunsupported
nodropaction nodropaction
helper bad missing have (c:cs) helper bad missing have (c:cs) lockunsupported
| isSafeDrop need have removallock = | isSafeDrop need have removallock =
liftIO (mkSafeDropProof need have removallock) >>= \case liftIO (mkSafeDropProof need have removallock) >>= \case
Right proof -> dropaction proof Right proof -> dropaction proof
Left stillhave -> helper bad missing stillhave (c:cs) Left stillhave -> helper bad missing stillhave (c:cs) lockunsupported
| otherwise = case c of | otherwise = case c of
UnVerifiedHere -> lockContentShared key contverified UnVerifiedHere -> lockContentShared key contverified
UnVerifiedRemote r -> checkremote r contverified $ UnVerifiedRemote r -> checkremote r contverified $
Remote.hasKey r key >>= \case let lockunsupported' = r : lockunsupported
Right True -> helper bad missing (mkVerifiedCopy RecentlyVerifiedCopy r : have) cs in Remote.hasKey r key >>= \case
Left _ -> helper (r:bad) missing have cs Right True -> helper bad missing (mkVerifiedCopy RecentlyVerifiedCopy r : have) cs lockunsupported'
Right False -> helper bad (Remote.uuid r:missing) have cs Left _ -> helper (r:bad) missing have cs lockunsupported'
Right False -> helper bad (Remote.uuid r:missing) have cs lockunsupported'
where where
contverified vc = helper bad missing (vc : have) cs contverified vc = helper bad missing (vc : have) cs lockunsupported
checkremote r cont fallback = case Remote.lockContent r of checkremote r cont fallback = case Remote.lockContent r of
Just lockcontent -> do Just lockcontent -> do
@ -176,8 +177,8 @@ data DropException = DropException SomeException
instance Exception DropException instance Exception DropException
notEnoughCopies :: Key -> NumCopies -> [VerifiedCopy] -> [UUID] -> [Remote] -> String -> Annex () notEnoughCopies :: Key -> NumCopies -> [VerifiedCopy] -> [UUID] -> [Remote] -> String -> [Remote] -> Annex ()
notEnoughCopies key need have skip bad nolocmsg = do notEnoughCopies key need have skip bad nolocmsg lockunsupported = do
showNote "unsafe" showNote "unsafe"
if length have < fromNumCopies need if length have < fromNumCopies need
then showLongNote $ then showLongNote $
@ -185,8 +186,12 @@ notEnoughCopies key need have skip bad nolocmsg = do
show (length have) ++ " out of " ++ show (fromNumCopies need) ++ show (length have) ++ " out of " ++ show (fromNumCopies need) ++
" necessary copies" " necessary copies"
else do else do
showLongNote "Unable to lock down 1 copy of file that is required to safely drop it." showLongNote $ "Unable to lock down 1 copy of file that is required to safely drop it."
showLongNote "(This could have happened because of a concurrent drop, or because a remote has too old a version of git-annex-shell installed.)" if null lockunsupported
then showLongNote "(This could have happened because of a concurrent drop, or because a remote has too old a version of git-annex-shell installed.)"
else showLongNote $ "These remotes do not support locking: "
++ Remote.listRemoteNames lockunsupported
Remote.showTriedRemotes bad Remote.showTriedRemotes bad
Remote.showLocations True key (map toUUID have++skip) nolocmsg Remote.showLocations True key (map toUUID have++skip) nolocmsg

View file

@ -52,6 +52,7 @@ module Remote (
nameToUUID, nameToUUID,
nameToUUID', nameToUUID',
showTriedRemotes, showTriedRemotes,
listRemoteNames,
showLocations, showLocations,
forceTrust, forceTrust,
logStatus, logStatus,
@ -365,8 +366,11 @@ showLocations separateuntrusted key exclude nolocmsg = do
showTriedRemotes :: [Remote] -> Annex () showTriedRemotes :: [Remote] -> Annex ()
showTriedRemotes [] = noop showTriedRemotes [] = noop
showTriedRemotes remotes = showTriedRemotes remotes =
showLongNote $ "Unable to access these remotes: " ++ showLongNote $ "Unable to access these remotes: "
intercalate ", " (map name remotes) ++ listRemoteNames remotes
listRemoteNames :: [Remote] -> String
listRemoteNames remotes = intercalate ", " (map name remotes)
forceTrust :: TrustLevel -> String -> Annex () forceTrust :: TrustLevel -> String -> Annex ()
forceTrust level remotename = do forceTrust level remotename = do