diff options
| -rw-r--r-- | Command/Status.hs | 30 | ||||
| -rw-r--r-- | Command/Vicfg.hs | 115 | ||||
| -rw-r--r-- | GitAnnex.hs | 2 | ||||
| -rw-r--r-- | Limit.hs | 3 | ||||
| -rw-r--r-- | Locations.hs | 5 | ||||
| -rw-r--r-- | Logs/Trust.hs | 40 | ||||
| -rw-r--r-- | Remote.hs | 2 | ||||
| -rw-r--r-- | Types/TrustLevel.hs | 19 | ||||
| -rw-r--r-- | debian/changelog | 2 | ||||
| -rw-r--r-- | doc/git-annex.mdwn | 6 |
10 files changed, 179 insertions, 45 deletions
diff --git a/Command/Status.hs b/Command/Status.hs index a3f5f1df7..ab7dbb007 100644 --- a/Command/Status.hs +++ b/Command/Status.hs @@ -11,8 +11,8 @@ module Command.Status where import Control.Monad.State.Strict import qualified Data.Map as M -import qualified Data.Set as S import Text.JSON +import Data.Tuple import Common.Annex import qualified Types.Backend as B @@ -33,8 +33,7 @@ import Remote import Config import Utility.Percentage import Logs.Transfer -import Logs.Group -import Types.Group +import Types.TrustLevel -- a named computation that produces a statistic type Stat = StatState (Maybe (String, StatState String)) @@ -70,11 +69,10 @@ fast_stats :: [Stat] fast_stats = [ supported_backends , supported_remote_types - , remote_list Trusted "trusted" - , remote_list SemiTrusted "semitrusted" - , remote_list UnTrusted "untrusted" - , remote_list DeadTrusted "dead" - , group_list + , remote_list Trusted + , remote_list SemiTrusted + , remote_list UnTrusted + , remote_list DeadTrusted , transfer_list , disk_size ] @@ -129,14 +127,14 @@ supported_remote_types :: Stat supported_remote_types = stat "supported remote types" $ json unwords $ return $ map R.typename Remote.remoteTypes -remote_list :: TrustLevel -> String -> Stat -remote_list level desc = stat n $ nojson $ lift $ do +remote_list :: TrustLevel -> Stat +remote_list level = stat n $ nojson $ lift $ do 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 where - n = desc ++ " repositories" + n = showTrustLevel level ++ " repositories" local_annex_size :: Stat local_annex_size = stat "local annex size" $ json id $ @@ -176,14 +174,6 @@ bloom_info = stat "bloom filter size" $ json id $ do return $ size ++ note -group_list :: Stat -group_list = stat "repository groups" $ nojson $ lift $ do - m <- uuidsByGroup <$> groupMap - ls <- forM (M.toList m) $ \(g, s) -> do - l <- Remote.prettyListUUIDs (S.toList s) - return $ g ++ ": " ++ intercalate ", " l - return $ show (M.size m) ++ multiLine ls - transfer_list :: Stat transfer_list = stat "transfers in progress" $ nojson $ lift $ do uuidmap <- Remote.remoteMap id @@ -228,7 +218,6 @@ backend_usage = stat "backend usage" $ nojson $ map (\(n, b) -> b ++ ": " ++ show n) $ reverse $ sort $ map swap $ M.toList $ M.unionWith (+) x y - swap (x, y) = (y, x) cachedPresentData :: StatState KeyData cachedPresentData = do @@ -299,3 +288,4 @@ aside s = " (" ++ s ++ ")" multiLine :: [String] -> String multiLine = concatMap (\l -> "\n\t" ++ l) + diff --git a/Command/Vicfg.hs b/Command/Vicfg.hs new file mode 100644 index 000000000..7e073a00a --- /dev/null +++ b/Command/Vicfg.hs @@ -0,0 +1,115 @@ +{- git-annex command + - + - Copyright 2012 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Command.Vicfg where + +import qualified Data.Map as M +import qualified Data.Set as S +import System.Environment (getEnv) +import Data.Tuple (swap) + +import Common.Annex +import Command +import Annex.Perms +import Types.TrustLevel +import Types.Group +import Logs.Trust +import Logs.Group +import Remote + +def :: [Command] +def = [command "vicfg" paramNothing seek + "edit git-annex's configuration"] + +seek :: [CommandSeek] +seek = [withNothing start] + +start :: CommandStart +start = do + f <- fromRepo gitAnnexTmpCfgFile + createAnnexDirectory (parentDir f) + liftIO . writeFile f =<< genCfg <$> getCfg + vicfg f + stop + +vicfg :: FilePath -> Annex () +vicfg f = do + vi <- liftIO $ catchDefaultIO "vi" $ getEnv "EDITOR" + -- Allow EDITOR to be processed by the shell, so it can contain options. + unlessM (liftIO $ boolSystem "sh" [Param "-c", Param $ unwords [vi, f]]) $ + error $ vi ++ " exited nonzero; aborting" + r <- parseCfg <$> liftIO (readFileStrict f) + liftIO $ nukeFile f + case r of + Left s -> do + liftIO $ writeFile f s + vicfg f + Right c -> setCfg c + +data Cfg = Cfg + { cfgTrustMap :: TrustMap + , cfgGroupMap :: M.Map UUID (S.Set Group) + , cfgDescriptions :: M.Map UUID String + } + +getCfg :: Annex Cfg +getCfg = Cfg + <$> trustMapRaw -- without local trust overrides + <*> (groupsByUUID <$> groupMap) + <*> uuidDescriptions + +setCfg :: Cfg -> Annex () +setCfg = error "TODO setCfg" + +genCfg :: Cfg -> String +genCfg cfg = unlines $ concat + [intro, trustintro, trust, defaulttrust, groupsintro, groups, defaultgroups] + where + intro = + [ com "git-annex configuration" + , com "" + , com "Changes saved to this file will be recorded in the git-annex branch." + , com "" + , com "Lines in this file have the format:" + , com " setting repo = value" + ] + trustintro = + [ "" + , com "Repository trust configuration" + , com "(Valid trust levels: " ++ + unwords (map showTrustLevel [Trusted .. DeadTrusted]) ++ + ")" + ] + trust = map (\(t, u) -> line "trust" u $ showTrustLevel t) $ + sort $ map swap $ M.toList $ cfgTrustMap cfg + defaulttrust = map (\u -> pcom $ line "trust" u $ showTrustLevel SemiTrusted) $ + missing cfgTrustMap + groupsintro = + [ "" + , com "Repository groups" + , com "(Separate group names with spaces)" + ] + groups = map (\(s, u) -> line "group" u $ unwords $ S.toList s) $ + sort $ map swap $ M.toList $ cfgGroupMap cfg + defaultgroups = map (\u -> pcom $ line "group" u "") $ + missing cfgGroupMap + line setting u value = unwords + [ setting + , showu u + , "=" + , value + ] + com s = "# " ++ s + pcom s = "#" ++ s + showu u = fromMaybe (fromUUID u) $ + M.lookup u (cfgDescriptions cfg) + missing field = S.toList $ M.keysSet (cfgDescriptions cfg) `S.difference` M.keysSet (field cfg) + +{- If there's a parse error, returns a new version of the file, + - with the problem lines noted. -} +parseCfg :: String -> Either String Cfg +parseCfg = undefined diff --git a/GitAnnex.hs b/GitAnnex.hs index 9b84f5c46..be5af113d 100644 --- a/GitAnnex.hs +++ b/GitAnnex.hs @@ -57,6 +57,7 @@ import qualified Command.Semitrust import qualified Command.Dead import qualified Command.Group import qualified Command.Ungroup +import qualified Command.Vicfg import qualified Command.Sync import qualified Command.AddUrl import qualified Command.Import @@ -96,6 +97,7 @@ cmds = concat , Command.Dead.def , Command.Group.def , Command.Ungroup.def + , Command.Vicfg.def , Command.FromKey.def , Command.DropKey.def , Command.TransferKey.def @@ -19,6 +19,7 @@ import qualified Remote import qualified Backend import Annex.Content import Logs.Trust +import Types.TrustLevel import Logs.Group import Utility.HumanTime @@ -91,7 +92,7 @@ addCopies :: String -> Annex () addCopies want = addLimit . check $ readnum num where (num, good) = case split ":" want of - [v, n] -> case readTrust v of + [v, n] -> case readTrustLevel v of Just trust -> (n, checktrust trust) Nothing -> (n, checkgroup v) [n] -> (n, const $ return True) diff --git a/Locations.hs b/Locations.hs index 72baf273b..4bb2a2274 100644 --- a/Locations.hs +++ b/Locations.hs @@ -30,6 +30,7 @@ module Locations ( gitAnnexLogFile, gitAnnexHtmlShim, gitAnnexUrlFile, + gitAnnexTmpCfgFile, gitAnnexSshDir, gitAnnexRemotesDir, gitAnnexAssistantDefaultDir, @@ -183,6 +184,10 @@ gitAnnexHtmlShim r = gitAnnexDir r </> "webapp.html" gitAnnexUrlFile :: Git.Repo -> FilePath gitAnnexUrlFile r = gitAnnexDir r </> "url" +{- Temporary file used to edit configuriation from the git-annex branch. -} +gitAnnexTmpCfgFile :: Git.Repo -> FilePath +gitAnnexTmpCfgFile r = gitAnnexDir r </> "config.tmp" + {- .git/annex/ssh/ is used for ssh connection caching -} gitAnnexSshDir :: Git.Repo -> FilePath gitAnnexSshDir r = addTrailingPathSeparator $ gitAnnexDir r </> "ssh" diff --git a/Logs/Trust.hs b/Logs/Trust.hs index a929832a0..ce7615ba5 100644 --- a/Logs/Trust.hs +++ b/Logs/Trust.hs @@ -10,8 +10,8 @@ module Logs.Trust ( trustGet, trustSet, trustPartition, - readTrust, lookupTrust, + trustMapRaw, ) where import qualified Data.Map as M @@ -42,7 +42,9 @@ trustSet :: UUID -> TrustLevel -> Annex () trustSet uuid@(UUID _) level = do ts <- liftIO getPOSIXTime Annex.Branch.change trustLog $ - showLog showTrust . changeLog ts uuid level . parseLog (Just . parseTrust) + showLog showTrustLog . + changeLog ts uuid level . + parseLog (Just . parseTrustLog) Annex.changeState $ \s -> s { Annex.trustmap = Nothing } trustSet NoUUID _ = error "unknown UUID; cannot modify trust level" @@ -72,38 +74,34 @@ trustMap = do Just m -> return m Nothing -> do overrides <- Annex.getState Annex.forcetrust - logged <- simpleMap . parseLog (Just . parseTrust) <$> - Annex.Branch.get trustLog - configured <- M.fromList . catMaybes <$> - (mapM configuredtrust =<< remoteList) + logged <- trustMapRaw + configured <- M.fromList . catMaybes + <$> (mapM configuredtrust =<< remoteList) let m = M.union overrides $ M.union configured logged Annex.changeState $ \s -> s { Annex.trustmap = Just m } return m where configuredtrust r = maybe Nothing (\l -> Just (Types.Remote.uuid r, l)) <$> - maybe Nothing readTrust <$> - getTrustLevel (Types.Remote.repo r) + maybe Nothing readTrustLevel + <$> getTrustLevel (Types.Remote.repo r) -readTrust :: String -> Maybe TrustLevel -readTrust "trusted" = Just Trusted -readTrust "untrusted" = Just UnTrusted -readTrust "semitrusted" = Just SemiTrusted -readTrust "dead" = Just DeadTrusted -readTrust _ = Nothing +trustMapRaw :: Annex TrustMap +trustMapRaw = simpleMap . parseLog (Just . parseTrustLog) + <$> Annex.Branch.get trustLog {- The trust.log used to only list trusted repos, without a field for the - trust status, which is why this defaults to Trusted. -} -parseTrust :: String -> TrustLevel -parseTrust s = maybe Trusted parse $ headMaybe $ words s +parseTrustLog :: String -> TrustLevel +parseTrustLog s = maybe Trusted parse $ headMaybe $ words s where parse "1" = Trusted parse "0" = UnTrusted parse "X" = DeadTrusted parse _ = SemiTrusted -showTrust :: TrustLevel -> String -showTrust Trusted = "1" -showTrust UnTrusted = "0" -showTrust DeadTrusted = "X" -showTrust SemiTrusted = "?" +showTrustLog :: TrustLevel -> String +showTrustLog Trusted = "1" +showTrustLog UnTrusted = "0" +showTrustLog DeadTrusted = "X" +showTrustLog SemiTrusted = "?" @@ -42,6 +42,7 @@ module Remote ( import qualified Data.Map as M import Text.JSON import Text.JSON.Generic +import Data.Tuple import Common.Annex import Types.Remote @@ -100,7 +101,6 @@ nameToUUID n = byName' n >>= go Nothing -> return $ byuuid m byuuid m = M.lookup (toUUID n) $ transform double m transform a = M.fromList . map a . M.toList - swap (a, b) = (b, a) double (a, _) = (a, a) {- Pretty-prints a list of UUIDs of remotes, for human display. diff --git a/Types/TrustLevel.hs b/Types/TrustLevel.hs index 99d749730..83e4e5a5e 100644 --- a/Types/TrustLevel.hs +++ b/Types/TrustLevel.hs @@ -7,7 +7,9 @@ module Types.TrustLevel ( TrustLevel(..), - TrustMap + TrustMap, + readTrustLevel, + showTrustLevel, ) where import qualified Data.Map as M @@ -15,6 +17,19 @@ import qualified Data.Map as M import Types.UUID data TrustLevel = Trusted | SemiTrusted | UnTrusted | DeadTrusted - deriving Eq + deriving (Eq, Enum, Ord) type TrustMap = M.Map UUID TrustLevel + +readTrustLevel :: String -> Maybe TrustLevel +readTrustLevel "trusted" = Just Trusted +readTrustLevel "untrusted" = Just UnTrusted +readTrustLevel "semitrusted" = Just SemiTrusted +readTrustLevel "dead" = Just DeadTrusted +readTrustLevel _ = Nothing + +showTrustLevel :: TrustLevel -> String +showTrustLevel Trusted = "trusted" +showTrustLevel UnTrusted = "untrusted" +showTrustLevel SemiTrusted = "semitrusted" +showTrustLevel DeadTrusted = "dead" diff --git a/debian/changelog b/debian/changelog index c025db900..0af82383b 100644 --- a/debian/changelog +++ b/debian/changelog @@ -6,6 +6,8 @@ git-annex (3.20121002) UNRELEASED; urgency=low * watch, assistant: It's now safe to git annex unlock files while the watcher is running, as well as modify files checked into git as normal files. + * vicfg: New command, allows editing (or simply viewing) most + of the repository configuration settings stored in the git-annex branch. -- Joey Hess <joeyh@debian.org> Mon, 01 Oct 2012 15:09:49 -0400 diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index f8f09b5b9..abda54f76 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -257,6 +257,12 @@ subdirectories). Removes a repository from a group. +* vicfg + + Opens EDITOR on a temp file containing most of the above configuration + settings, and when it exits, stores any changes made back to the git-annex + branch. + # REPOSITORY MAINTENANCE COMMANDS * fsck [path ...] |