summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-10-01 15:12:04 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-10-01 15:12:04 -0400
commit59d2f363b7a2762978978bb3edf62aa47ef81abd (patch)
tree6519760756a8d9cef3558a91ab3cbc69f1e58ac3
parent65315e13716443be3c50f7e556a1206a45df2a32 (diff)
group, ungroup: New commands to indicate groups of repositories.
-rw-r--r--Annex.hs3
-rw-r--r--Command/Group.hs35
-rw-r--r--Command/Ungroup.hs35
-rw-r--r--GitAnnex.hs4
-rw-r--r--Logs/Group.hs52
-rw-r--r--Types/Group.hs20
-rw-r--r--Usage.hs2
-rw-r--r--debian/changelog6
-rw-r--r--doc/git-annex.mdwn9
-rw-r--r--doc/internals.mdwn8
10 files changed, 174 insertions, 0 deletions
diff --git a/Annex.hs b/Annex.hs
index 32edeff5c..87edb7c13 100644
--- a/Annex.hs
+++ b/Annex.hs
@@ -45,6 +45,7 @@ import qualified Types.Remote
import Types.Crypto
import Types.BranchState
import Types.TrustLevel
+import Types.Group
import Types.Messages
import Utility.State
import qualified Utility.Matcher
@@ -92,6 +93,7 @@ data AnnexState = AnnexState
, shared :: Maybe SharedRepository
, forcetrust :: TrustMap
, trustmap :: Maybe TrustMap
+ , groupmap :: Maybe GroupMap
, ciphers :: M.Map StorableCipher Cipher
, lockpool :: M.Map FilePath Fd
, flags :: M.Map String Bool
@@ -118,6 +120,7 @@ newState gitrepo = AnnexState
, shared = Nothing
, forcetrust = M.empty
, trustmap = Nothing
+ , groupmap = Nothing
, ciphers = M.empty
, lockpool = M.empty
, flags = M.empty
diff --git a/Command/Group.hs b/Command/Group.hs
new file mode 100644
index 000000000..2952f2142
--- /dev/null
+++ b/Command/Group.hs
@@ -0,0 +1,35 @@
+{- git-annex command
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.Group where
+
+import Common.Annex
+import Command
+import qualified Remote
+import Logs.Group
+import Types.Group
+
+import qualified Data.Set as S
+
+def :: [Command]
+def = [command "group" (paramPair paramRemote paramDesc) seek "add a repository to a group"]
+
+seek :: [CommandSeek]
+seek = [withWords start]
+
+start :: [String] -> CommandStart
+start (name:g:[]) = do
+ showStart "group" name
+ u <- Remote.nameToUUID name
+ next $ perform u g
+start _ = error "Specify a repository and a group."
+
+perform :: UUID -> Group -> CommandPerform
+perform uuid g = do
+ s <- lookupGroups uuid
+ groupSet uuid (S.insert g s)
+ next $ return True
diff --git a/Command/Ungroup.hs b/Command/Ungroup.hs
new file mode 100644
index 000000000..2161cec91
--- /dev/null
+++ b/Command/Ungroup.hs
@@ -0,0 +1,35 @@
+{- git-annex command
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.Ungroup where
+
+import Common.Annex
+import Command
+import qualified Remote
+import Logs.Group
+import Types.Group
+
+import qualified Data.Set as S
+
+def :: [Command]
+def = [command "ungroup" (paramPair paramRemote paramDesc) seek "remove a repository from a group"]
+
+seek :: [CommandSeek]
+seek = [withWords start]
+
+start :: [String] -> CommandStart
+start (name:g:[]) = do
+ showStart "ungroup" name
+ u <- Remote.nameToUUID name
+ next $ perform u g
+start _ = error "Specify a repository and a group."
+
+perform :: UUID -> Group -> CommandPerform
+perform uuid g = do
+ s <- lookupGroups uuid
+ groupSet uuid (S.delete g s)
+ next $ return True
diff --git a/GitAnnex.hs b/GitAnnex.hs
index c6fc5210f..9b84f5c46 100644
--- a/GitAnnex.hs
+++ b/GitAnnex.hs
@@ -55,6 +55,8 @@ import qualified Command.Trust
import qualified Command.Untrust
import qualified Command.Semitrust
import qualified Command.Dead
+import qualified Command.Group
+import qualified Command.Ungroup
import qualified Command.Sync
import qualified Command.AddUrl
import qualified Command.Import
@@ -92,6 +94,8 @@ cmds = concat
, Command.Untrust.def
, Command.Semitrust.def
, Command.Dead.def
+ , Command.Group.def
+ , Command.Ungroup.def
, Command.FromKey.def
, Command.DropKey.def
, Command.TransferKey.def
diff --git a/Logs/Group.hs b/Logs/Group.hs
new file mode 100644
index 000000000..9263c7760
--- /dev/null
+++ b/Logs/Group.hs
@@ -0,0 +1,52 @@
+{- git-annex group log
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Logs.Group (
+ groupSet,
+ lookupGroups,
+ groupMap,
+) where
+
+import qualified Data.Map as M
+import qualified Data.Set as S
+import Data.Time.Clock.POSIX
+
+import Common.Annex
+import qualified Annex.Branch
+import qualified Annex
+import Logs.UUIDBased
+import Types.Group
+
+{- Filename of group.log. -}
+groupLog :: FilePath
+groupLog = "group.log"
+
+{- Returns the groups of a given repo UUID. -}
+lookupGroups :: UUID -> Annex (S.Set Group)
+lookupGroups u = (fromMaybe S.empty . M.lookup u) <$> groupMap
+
+{- Changes the groups for a uuid in the groupLog. -}
+groupSet :: UUID -> S.Set Group -> Annex ()
+groupSet uuid@(UUID _) groups = do
+ ts <- liftIO getPOSIXTime
+ Annex.Branch.change groupLog $
+ showLog (unwords . S.toList) . changeLog ts uuid groups .
+ parseLog (Just . S.fromList . words)
+ Annex.changeState $ \s -> s { Annex.groupmap = Nothing }
+groupSet NoUUID _ = error "unknown UUID; cannot modify group"
+
+{- Read the groupLog into a map. The map is cached for speed. -}
+groupMap :: Annex GroupMap
+groupMap = do
+ cached <- Annex.getState Annex.groupmap
+ case cached of
+ Just m -> return m
+ Nothing -> do
+ m <- simpleMap . parseLog (Just . S.fromList . words) <$>
+ Annex.Branch.get groupLog
+ Annex.changeState $ \s -> s { Annex.groupmap = Just m }
+ return m
diff --git a/Types/Group.hs b/Types/Group.hs
new file mode 100644
index 000000000..dd06cbfd7
--- /dev/null
+++ b/Types/Group.hs
@@ -0,0 +1,20 @@
+{- git-annex repo groups
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Types.Group (
+ Group,
+ GroupMap
+) where
+
+import Types.UUID
+
+import qualified Data.Map as M
+import qualified Data.Set as S
+
+type Group = String
+
+type GroupMap = M.Map UUID (S.Set Group)
diff --git a/Usage.hs b/Usage.hs
index 04024b165..e411719b0 100644
--- a/Usage.hs
+++ b/Usage.hs
@@ -83,6 +83,8 @@ paramFormat :: String
paramFormat = "FORMAT"
paramFile :: String
paramFile = "FILE"
+paramGroup :: String
+paramGroup = "GROUP"
paramKeyValue :: String
paramKeyValue = "K=V"
paramNothing :: String
diff --git a/debian/changelog b/debian/changelog
index a82ef7ebc..57da10688 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,9 @@
+git-annex (3.20121002) UNRELEASED; urgency=low
+
+ * group, ungroup: New commands to indicate groups of repositories.
+
+ -- Joey Hess <joeyh@debian.org> Mon, 01 Oct 2012 15:09:49 -0400
+
git-annex (3.20121001) unstable; urgency=low
* fsck: Now has an incremental mode. Start a new incremental fsck pass
diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn
index c1bbb8259..50de5e389 100644
--- a/doc/git-annex.mdwn
+++ b/doc/git-annex.mdwn
@@ -248,6 +248,15 @@ subdirectories).
Indicates that the repository has been irretrevably lost.
(To undo, use semitrust.)
+* group repository groupname
+
+ Adds a repository to a group, such as "archival", "enduser", or "transfer".
+ The groupname must be a single word.
+
+* ungroup repository groupname
+
+ Removes a repository from a group.
+
# REPOSITORY MAINTENANCE COMMANDS
* fsck [path ...]
diff --git a/doc/internals.mdwn b/doc/internals.mdwn
index a69a747e5..26e1d2fc2 100644
--- a/doc/internals.mdwn
+++ b/doc/internals.mdwn
@@ -67,6 +67,14 @@ Example:
Repositories not listed are semi-trusted.
+## `group.log`
+
+Used to group repositories together.
+
+The file format is one line per repository, with the uuid followed by a space,
+and then a space-separated list of groups this repository is part of,
+and finally a timestamp.
+
## `aaa/bbb/*.log`
These log files record [[location_tracking]] information