make whereis show urls when web remote does not have content

This is needed when external special remotes register an url for a key.
This commit is contained in:
Joey Hess 2015-08-17 11:35:34 -04:00
parent 3a5b7dbaf0
commit 858104078a
2 changed files with 15 additions and 4 deletions

View file

@ -14,6 +14,7 @@ import Command
import Remote
import Logs.Trust
import Logs.Web
import Remote.Web (getWebUrls)
cmd :: Command
cmd = noCommit $ withGlobalOptions (jsonOption : annexedMatchingOptions) $
@ -60,6 +61,11 @@ perform remotemap key = do
unless (null safelocations) $ showLongNote pp
pp' <- prettyPrintUUIDs "untrusted" untrustedlocations
unless (null untrustedlocations) $ showLongNote $ untrustedheader ++ pp'
-- Since other remotes than the web remote can set urls
-- where a key can be downloaded, get and show all such urls
-- as a special case.
showRemote "web" =<< getWebUrls key
forM_ (mapMaybe (`M.lookup` remotemap) locations) $
performRemote key
if null safelocations then stop else next $ return True
@ -73,8 +79,7 @@ performRemote key remote = do
ls <- (++)
<$> askremote
<*> claimedurls
unless (null ls) $ showLongNote $ unlines $
map (\l -> name remote ++ ": " ++ l) ls
showRemote (name remote) ls
where
askremote = maybe (pure []) (flip id key) (whereisKey remote)
claimedurls = do
@ -83,3 +88,9 @@ performRemote key remote = do
. map getDownloader
<$> getUrls key
filterM (\u -> (==) <$> pure remote <*> claimingUrl u) us
showRemote :: String -> [String] -> Annex ()
showRemote n ls
| null ls = return ()
| otherwise = showLongNote $ unlines $
map (\l -> n ++ ": " ++ l) ls

View file

@ -7,7 +7,7 @@
{-# LANGUAGE CPP #-}
module Remote.Web (remote) where
module Remote.Web (remote, getWebUrls) where
import Common.Annex
import Types.Remote
@ -54,7 +54,7 @@ gen r _ c gc =
, removeKey = dropKey
, checkPresent = checkKey
, checkPresentCheap = False
, whereisKey = Just getWebUrls
, whereisKey = Nothing
, remoteFsck = Nothing
, repairRepo = Nothing
, config = c