vicfg: New command, allows editing (or simply viewing) most of the repository configuration settings stored in the git-annex branch.

Incomplete; I need to finish parsing and saving. This will also be used
for editing transfer control expresssions.

Removed the group display from the status output, I didn't really
like that format, and vicfg can be used to see as well as edit rempository
group membership.

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.TrustLevel
-import Types.Group
 
 -- 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 Trusted
-	, remote_list SemiTrusted "semitrusted"
+	, remote_list SemiTrusted
-	, remote_list UnTrusted "untrusted"
+	, remote_list UnTrusted
-	, remote_list DeadTrusted "dead"
+	, remote_list DeadTrusted
-	, group_list
 	, 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 :: TrustLevel -> Stat
-remote_list level desc = stat n $ nojson $ lift $ do
+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)
+

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

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

Limit.hs

@@ -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)

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"

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) <$>
+			logged <- trustMapRaw
-				Annex.Branch.get trustLog
+			configured <- M.fromList . catMaybes
-			configured <- M.fromList . catMaybes <$>
+				<$> (mapM configuredtrust =<< remoteList)
-				(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 <$>
+				maybe Nothing readTrustLevel
-					getTrustLevel (Types.Remote.repo r)
+					<$> getTrustLevel (Types.Remote.repo r)
 
-readTrust :: String -> Maybe TrustLevel
+trustMapRaw :: Annex TrustMap
-readTrust "trusted" = Just Trusted
+trustMapRaw = simpleMap . parseLog (Just . parseTrustLog)
-readTrust "untrusted" = Just UnTrusted
+	<$> Annex.Branch.get trustLog
-readTrust "semitrusted" = Just SemiTrusted
-readTrust "dead" = Just DeadTrusted
-readTrust _ = Nothing
 
 {- 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
+parseTrustLog :: String -> TrustLevel
-parseTrust s = maybe Trusted parse $ headMaybe $ words s
+parseTrustLog s = maybe Trusted parse $ headMaybe $ words s
 	where
 		parse "1" = Trusted
 		parse "0" = UnTrusted
 		parse "X" = DeadTrusted
 		parse _ = SemiTrusted
 
-showTrust :: TrustLevel -> String
+showTrustLog :: TrustLevel -> String
-showTrust Trusted = "1"
+showTrustLog Trusted = "1"
-showTrust UnTrusted = "0"
+showTrustLog UnTrusted = "0"
-showTrust DeadTrusted = "X"
+showTrustLog DeadTrusted = "X"
-showTrust SemiTrusted = "?"
+showTrustLog SemiTrusted = "?"

Remote.hs

@@ -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.

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"

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
 

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 ...]