summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Command/Status.hs30
-rw-r--r--Command/Vicfg.hs115
-rw-r--r--GitAnnex.hs2
-rw-r--r--Limit.hs3
-rw-r--r--Locations.hs5
-rw-r--r--Logs/Trust.hs40
-rw-r--r--Remote.hs2
-rw-r--r--Types/TrustLevel.hs19
-rw-r--r--debian/changelog2
-rw-r--r--doc/git-annex.mdwn6
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
diff --git a/Limit.hs b/Limit.hs
index 6f83c0e38..dd512689f 100644
--- a/Limit.hs
+++ b/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)
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 = "?"
diff --git a/Remote.hs b/Remote.hs
index a5686dd44..b067fa749 100644
--- a/Remote.hs
+++ b/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.
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 ...]