df6f9f1ee8
Searched for uses of putStr and hPutStr and changed appropriate ones to filter out control characters and quote filenames. This notably does not make find and findkeys quote filenames in their default output. Because they should only do that when stdout is non a pipe. A few commands like calckey and lookupkey seem too low-level to make sense to filter output, so skipped those. Also when relaying output from other commands that is not progress output, have git-annex filter out control characters. Sponsored-by: k0ld on Patreon
109 lines
3 KiB
Haskell
109 lines
3 KiB
Haskell
{- git-annex command
|
|
-
|
|
- Copyright 2013 Joey Hess <id@joeyh.name>
|
|
- Copyright 2013 Antoine Beaupré
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Command.List where
|
|
|
|
import qualified Data.Set as S
|
|
import qualified Data.Map as M
|
|
import Data.Function
|
|
import Data.Ord
|
|
import qualified Data.ByteString.Char8 as B8
|
|
|
|
import Command
|
|
import Remote
|
|
import qualified Annex
|
|
import Logs.Trust
|
|
import Logs.UUID
|
|
import Annex.UUID
|
|
import Git.Types (RemoteName)
|
|
import Utility.Tuple
|
|
import Utility.SafeOutput
|
|
|
|
cmd :: Command
|
|
cmd = noCommit $ withAnnexOptions [annexedMatchingOptions] $
|
|
command "list" SectionQuery
|
|
"show which remotes contain files"
|
|
paramPaths (seek <$$> optParser)
|
|
|
|
data ListOptions = ListOptions
|
|
{ listThese :: CmdParams
|
|
, allRepos :: Bool
|
|
}
|
|
|
|
optParser :: CmdParamsDesc -> Parser ListOptions
|
|
optParser desc = ListOptions
|
|
<$> cmdParams desc
|
|
<*> switch
|
|
( long "allrepos"
|
|
<> help "show all repositories, not only remotes"
|
|
)
|
|
|
|
seek :: ListOptions -> CommandSeek
|
|
seek o = do
|
|
list <- getList o
|
|
printHeader list
|
|
let seeker = AnnexedFileSeeker
|
|
{ startAction = start list
|
|
, checkContentPresent = Nothing
|
|
, usesLocationLog = True
|
|
}
|
|
withFilesInGitAnnex ww seeker =<< workTreeItems ww (listThese o)
|
|
where
|
|
ww = WarnUnmatchLsFiles
|
|
|
|
getList :: ListOptions -> Annex [(UUID, RemoteName, TrustLevel)]
|
|
getList o
|
|
| allRepos o = nubBy ((==) `on` fst3) <$> ((++) <$> getRemotes <*> getAllUUIDs)
|
|
| otherwise = getRemotes
|
|
where
|
|
getRemotes = do
|
|
rs <- remoteList
|
|
ts <- mapM (lookupTrust . uuid) rs
|
|
hereu <- getUUID
|
|
heretrust <- lookupTrust hereu
|
|
let l = (hereu, "here", heretrust) : zip3 (map uuid rs) (map name rs) ts
|
|
return $ filter (\(_, _, t) -> t /= DeadTrusted) l
|
|
getAllUUIDs = do
|
|
rs <- M.toList <$> uuidDescMap
|
|
rs3 <- forM rs $ \(u, d) -> (,,)
|
|
<$> pure u
|
|
<*> pure (fromUUIDDesc d)
|
|
<*> lookupTrust u
|
|
return $ sortBy (comparing snd3) $
|
|
filter (\t -> thd3 t /= DeadTrusted) rs3
|
|
|
|
printHeader :: [(UUID, RemoteName, TrustLevel)] -> Annex ()
|
|
printHeader l = liftIO $ putStrLn $ safeOutput $ lheader $ map (\(_, n, t) -> (n, t)) l
|
|
|
|
start :: [(UUID, RemoteName, TrustLevel)] -> SeekInput -> RawFilePath -> Key -> CommandStart
|
|
start l _si file key = do
|
|
ls <- S.fromList <$> keyLocations key
|
|
qp <- coreQuotePath <$> Annex.getGitConfig
|
|
liftIO $ B8.putStrLn $ quote qp $
|
|
format (map (\(u, _, t) -> (t, S.member u ls)) l) file
|
|
stop
|
|
|
|
type Present = Bool
|
|
|
|
lheader :: [(RemoteName, TrustLevel)] -> String
|
|
lheader remotes = unlines (zipWith formatheader [0..] remotes) ++ pipes (length remotes)
|
|
where
|
|
formatheader n (remotename, trustlevel) = pipes n ++ remotename ++ trust trustlevel
|
|
pipes = flip replicate '|'
|
|
trust UnTrusted = " (untrusted)"
|
|
trust _ = ""
|
|
|
|
format :: [(TrustLevel, Present)] -> RawFilePath -> StringContainingQuotedPath
|
|
format remotes file = UnquotedString (thereMap) <> " " <> QuotedPath file
|
|
where
|
|
thereMap = concatMap there remotes
|
|
there (UnTrusted, True) = "x"
|
|
there (_, True) = "X"
|
|
there (_, False) = "_"
|