diff options
| -rw-r--r-- | Command/Status.hs | 2 | ||||
| -rw-r--r-- | Command/Whereis.hs | 28 | ||||
| -rw-r--r-- | Remote.hs | 9 | ||||
| -rw-r--r-- | Remote/Bup.hs | 1 | ||||
| -rw-r--r-- | Remote/Directory.hs | 1 | ||||
| -rw-r--r-- | Remote/Git.hs | 1 | ||||
| -rw-r--r-- | Remote/Hook.hs | 1 | ||||
| -rw-r--r-- | Remote/Rsync.hs | 1 | ||||
| -rw-r--r-- | Remote/S3.hs | 1 | ||||
| -rw-r--r-- | Remote/Web.hs | 1 | ||||
| -rw-r--r-- | Types/Remote.hs | 2 | ||||
| -rw-r--r-- | debian/changelog | 1 |
12 files changed, 37 insertions, 12 deletions
diff --git a/Command/Status.hs b/Command/Status.hs index 5facaab9b..dfe847bb8 100644 --- a/Command/Status.hs +++ b/Command/Status.hs @@ -113,7 +113,7 @@ supported_remote_types = stat "supported remote types" $ json unwords $ remote_list :: TrustLevel -> String -> Stat remote_list level desc = stat n $ nojson $ lift $ do - us <- M.keys <$> (M.union <$> uuidMap <*> remoteMap) + us <- M.keys <$> (M.union <$> uuidMap <*> remoteMap Remote.name) rs <- fst <$> trustPartition level us s <- prettyPrintUUIDs n rs return $ if null s then "0" else show (length rs) ++ "\n" ++ beginning s diff --git a/Command/Whereis.hs b/Command/Whereis.hs index 1fbe70799..f62d34642 100644 --- a/Command/Whereis.hs +++ b/Command/Whereis.hs @@ -7,6 +7,8 @@ module Command.Whereis where +import qualified Data.Map as M + import Common.Annex import Command import Remote @@ -17,24 +19,36 @@ def = [command "whereis" paramPaths seek "lists repositories that have file content"] seek :: [CommandSeek] -seek = [withFilesInGit $ whenAnnexed start] +seek = [withValue (remoteMap id) $ \m -> + withFilesInGit $ whenAnnexed $ start m] -start :: FilePath -> (Key, Backend) -> CommandStart -start file (key, _) = do +start :: (M.Map UUID Remote) -> FilePath -> (Key, Backend) -> CommandStart +start remotemap file (key, _) = do showStart "whereis" file - next $ perform key + next $ perform remotemap key -perform :: Key -> CommandPerform -perform key = do - (untrustedlocations, safelocations) <- trustPartition UnTrusted =<< keyLocations key +perform :: (M.Map UUID Remote) -> Key -> CommandPerform +perform remotemap key = do + locations <- keyLocations key + (untrustedlocations, safelocations) <- trustPartition UnTrusted locations let num = length safelocations showNote $ show num ++ " " ++ copiesplural num pp <- prettyPrintUUIDs "whereis" safelocations unless (null safelocations) $ showLongNote pp pp' <- prettyPrintUUIDs "untrusted" untrustedlocations unless (null untrustedlocations) $ showLongNote $ untrustedheader ++ pp' + forM_ (catMaybes $ map (`M.lookup` remotemap) locations) $ + performRemote key if null safelocations then stop else next $ return True where copiesplural 1 = "copy" copiesplural _ = "copies" untrustedheader = "The following untrusted locations may also have copies:\n" + +performRemote :: Key -> Remote -> Annex () +performRemote key remote = case whereisKey remote of + Nothing -> return () + Just a -> do + ls <- a key + unless (null ls) $ showLongNote $ + unlines $ map (\l -> name remote ++ ": " ++ l) ls @@ -15,6 +15,7 @@ module Remote ( removeKey, hasKey, hasKeyCheap, + whereisKey, remoteTypes, remoteList, @@ -48,16 +49,16 @@ import Logs.Trust import Logs.Location import Remote.List -{- Map of UUIDs of Remotes and their names. -} -remoteMap :: Annex (M.Map UUID String) -remoteMap = M.fromList . map (\r -> (uuid r, name r)) . +{- Map from UUIDs of Remotes to a calculated value. -} +remoteMap :: (Remote -> a) -> Annex (M.Map UUID a) +remoteMap c = M.fromList . map (\r -> (uuid r, c r)) . filter (\r -> uuid r /= NoUUID) <$> remoteList {- Map of UUIDs and their descriptions. - The names of Remotes are added to suppliment any description that has - been set for a repository. -} uuidDescriptions :: Annex (M.Map UUID String) -uuidDescriptions = M.unionWith addName <$> uuidMap <*> remoteMap +uuidDescriptions = M.unionWith addName <$> uuidMap <*> remoteMap name addName :: String -> String -> String addName desc n diff --git a/Remote/Bup.hs b/Remote/Bup.hs index 50c3b10b3..a4f43a3f3 100644 --- a/Remote/Bup.hs +++ b/Remote/Bup.hs @@ -53,6 +53,7 @@ gen r u c = do removeKey = remove, hasKey = checkPresent r bupr', hasKeyCheap = bupLocal buprepo, + whereisKey = Nothing, config = c, repo = r, remotetype = remote diff --git a/Remote/Directory.hs b/Remote/Directory.hs index 85f644607..ee2a0d75a 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -45,6 +45,7 @@ gen r u c = do removeKey = remove dir, hasKey = checkPresent dir, hasKeyCheap = True, + whereisKey = Nothing, config = Nothing, repo = r, remotetype = remote diff --git a/Remote/Git.hs b/Remote/Git.hs index 390524775..c07ae3237 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -81,6 +81,7 @@ gen r u _ = do removeKey = dropKey r', hasKey = inAnnex r', hasKeyCheap = cheap, + whereisKey = Nothing, config = Nothing, repo = r', remotetype = remote diff --git a/Remote/Hook.hs b/Remote/Hook.hs index a08c4011e..c7d710f19 100644 --- a/Remote/Hook.hs +++ b/Remote/Hook.hs @@ -45,6 +45,7 @@ gen r u c = do removeKey = remove hooktype, hasKey = checkPresent r hooktype, hasKeyCheap = False, + whereisKey = Nothing, config = Nothing, repo = r, remotetype = remote diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs index c7efe4200..54fb890ca 100644 --- a/Remote/Rsync.hs +++ b/Remote/Rsync.hs @@ -52,6 +52,7 @@ gen r u c = do removeKey = remove o, hasKey = checkPresent r o, hasKeyCheap = False, + whereisKey = Nothing, config = Nothing, repo = r, remotetype = remote diff --git a/Remote/S3.hs b/Remote/S3.hs index c9527ba67..812345b00 100644 --- a/Remote/S3.hs +++ b/Remote/S3.hs @@ -57,6 +57,7 @@ gen' r u c cst = removeKey = remove this, hasKey = checkPresent this, hasKeyCheap = False, + whereisKey = Nothing, config = c, repo = r, remotetype = remote diff --git a/Remote/Web.hs b/Remote/Web.hs index 6bd04d4b1..81e6ca321 100644 --- a/Remote/Web.hs +++ b/Remote/Web.hs @@ -45,6 +45,7 @@ gen r _ _ = removeKey = dropKey, hasKey = checkKey, hasKeyCheap = False, + whereisKey = Just getUrls, config = Nothing, repo = r, remotetype = remote diff --git a/Types/Remote.hs b/Types/Remote.hs index 003dd5342..9bac2ca0f 100644 --- a/Types/Remote.hs +++ b/Types/Remote.hs @@ -55,6 +55,8 @@ data RemoteA a = Remote { -- Some remotes can check hasKey without an expensive network -- operation. hasKeyCheap :: Bool, + -- Some remotes can provide additional details for whereis. + whereisKey :: Maybe (Key -> a [String]), -- a Remote can have a persistent configuration store config :: Maybe RemoteConfig, -- git configuration for the remote diff --git a/debian/changelog b/debian/changelog index a5b0b31d1..8df49d925 100644 --- a/debian/changelog +++ b/debian/changelog @@ -24,6 +24,7 @@ git-annex (3.20120124) UNRELEASED; urgency=low its head), and records the size in the key. * Fixed to use the strict state monad, to avoid leaking all kinds of memory due to lazy state update thunks when adding/fixing many files. + * whereis: Prints the urls of files that the web special remote knows about. -- Joey Hess <joeyh@debian.org> Tue, 24 Jan 2012 16:21:55 -0400 |