12460fcea6
When --batch is used with matching options like --in, --metadata, etc, only operate on the provided files when they match those options. Otherwise, a blank line is output in the batch protocol. Affected commands: find, add, whereis, drop, copy, move, get In the case of find, the documentation for --batch already said it honored the matching options. The docs for the rest didn't, but it makes sense to have them honor them. While this is a behavior change, why specify the matching options with --batch if you didn't want them to apply? Note that the batch output for all of the affected commands could already output a blank line in other cases, so batch users should already be prepared to deal with it. git-annex metadata didn't seem worth making support the matching options, since all it does is output metadata or set metadata, the use cases for using it in combination with the martching options seem small. Made it refuse to run when they're combined, leaving open the possibility for later support if a use case develops. This commit was sponsored by Brett Eisenberg on Patreon.
111 lines
3.3 KiB
Haskell
111 lines
3.3 KiB
Haskell
{- git-annex command
|
|
-
|
|
- Copyright 2010-2016 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
module Command.Whereis where
|
|
|
|
import Command
|
|
import Remote
|
|
import Logs.Trust
|
|
import Logs.Web
|
|
import Remote.Web (getWebUrls)
|
|
import Annex.UUID
|
|
|
|
import qualified Data.Map as M
|
|
import qualified Data.Vector as V
|
|
|
|
cmd :: Command
|
|
cmd = noCommit $ withGlobalOptions [jsonOptions, annexedMatchingOptions] $
|
|
command "whereis" SectionQuery
|
|
"lists repositories that have file content"
|
|
paramPaths (seek <$$> optParser)
|
|
|
|
data WhereisOptions = WhereisOptions
|
|
{ whereisFiles :: CmdParams
|
|
, keyOptions :: Maybe KeyOptions
|
|
, batchOption :: BatchMode
|
|
}
|
|
|
|
optParser :: CmdParamsDesc -> Parser WhereisOptions
|
|
optParser desc = WhereisOptions
|
|
<$> cmdParams desc
|
|
<*> optional parseKeyOptions
|
|
<*> parseBatchOption
|
|
|
|
seek :: WhereisOptions -> CommandSeek
|
|
seek o = do
|
|
m <- remoteMap id
|
|
let go = whenAnnexed $ start m
|
|
case batchOption o of
|
|
Batch -> batchFilesMatching go
|
|
NoBatch ->
|
|
withKeyOptions (keyOptions o) False
|
|
(startKeys m)
|
|
(withFilesInGit go)
|
|
=<< workTreeItems (whereisFiles o)
|
|
|
|
start :: M.Map UUID Remote -> FilePath -> Key -> CommandStart
|
|
start remotemap file key = startKeys remotemap key (mkActionItem afile)
|
|
where
|
|
afile = AssociatedFile (Just file)
|
|
|
|
startKeys :: M.Map UUID Remote -> Key -> ActionItem -> CommandStart
|
|
startKeys remotemap key ai = do
|
|
showStartKey "whereis" key ai
|
|
next $ perform remotemap key
|
|
|
|
perform :: M.Map UUID Remote -> Key -> CommandPerform
|
|
perform remotemap key = do
|
|
locations <- keyLocations key
|
|
urls <- getUUIDUrls key locations remotemap
|
|
(untrustedlocations, safelocations) <- trustPartition UnTrusted locations
|
|
let num = length safelocations
|
|
showNote $ show num ++ " " ++ copiesplural num
|
|
pp <- ppwhereis "whereis" safelocations urls
|
|
unless (null safelocations) $ showLongNote pp
|
|
pp' <- ppwhereis "untrusted" untrustedlocations urls
|
|
unless (null untrustedlocations) $ showLongNote $ untrustedheader ++ pp'
|
|
|
|
mapM_ (showRemoteUrls remotemap) urls
|
|
|
|
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"
|
|
ppwhereis h ls urls = do
|
|
descm <- uuidDescriptions
|
|
let urlvals = map (\(u, us) -> (u, Just (V.fromList us))) $
|
|
filter (\(u,_) -> u `elem` ls) urls
|
|
prettyPrintUUIDsWith (Just "urls") h descm (const Nothing) urlvals
|
|
|
|
getUUIDUrls :: Key -> [UUID] -> M.Map UUID Remote -> Annex [(UUID, [URLString])]
|
|
getUUIDUrls key uuids remotemap = forM uuids $ \uu -> (,)
|
|
<$> pure uu
|
|
<*> maybe (pure []) (getRemoteUrls key) (M.lookup uu remotemap)
|
|
|
|
getRemoteUrls :: Key -> Remote -> Annex [URLString]
|
|
getRemoteUrls key remote
|
|
| uuid remote == webUUID = getWebUrls key
|
|
| otherwise = (++)
|
|
<$> askremote
|
|
<*> claimedurls
|
|
where
|
|
askremote = maybe (pure []) (flip id key) (whereisKey remote)
|
|
claimedurls = do
|
|
us <- map fst
|
|
. filter (\(_, d) -> d == OtherDownloader)
|
|
. map getDownloader
|
|
<$> getUrls key
|
|
filterM (\u -> (==) <$> pure remote <*> claimingUrl u) us
|
|
|
|
showRemoteUrls :: M.Map UUID Remote -> (UUID, [URLString]) -> Annex ()
|
|
showRemoteUrls remotemap (uu, us)
|
|
| null us = noop
|
|
| otherwise = case M.lookup uu remotemap of
|
|
Just r -> showLongNote $
|
|
unlines $ map (\u -> name r ++ ": " ++ u) us
|
|
Nothing -> noop
|