diff options
| -rw-r--r-- | Annex.hs | 3 | ||||
| -rw-r--r-- | Command/Group.hs | 35 | ||||
| -rw-r--r-- | Command/Ungroup.hs | 35 | ||||
| -rw-r--r-- | GitAnnex.hs | 4 | ||||
| -rw-r--r-- | Logs/Group.hs | 52 | ||||
| -rw-r--r-- | Types/Group.hs | 20 | ||||
| -rw-r--r-- | Usage.hs | 2 | ||||
| -rw-r--r-- | debian/changelog | 6 | ||||
| -rw-r--r-- | doc/git-annex.mdwn | 9 | ||||
| -rw-r--r-- | doc/internals.mdwn | 8 |
10 files changed, 174 insertions, 0 deletions
@@ -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) @@ -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 |