diff options
| -rw-r--r-- | Command/Describe.hs | 14 | ||||
| -rw-r--r-- | Command/Semitrust.hs | 13 | ||||
| -rw-r--r-- | Command/Trust.hs | 13 | ||||
| -rw-r--r-- | Command/Untrust.hs | 13 | ||||
| -rw-r--r-- | Remote.hs | 40 | ||||
| -rw-r--r-- | UUID.hs | 9 | ||||
| -rw-r--r-- | test.hs | 2 |
7 files changed, 58 insertions, 46 deletions
diff --git a/Command/Describe.hs b/Command/Describe.hs index 32aef4f24..9e98a8143 100644 --- a/Command/Describe.hs +++ b/Command/Describe.hs @@ -7,10 +7,8 @@ module Command.Describe where - import Command -import qualified GitRepo as Git -import qualified Remotes +import qualified Remote import UUID import Messages import qualified Command.Init @@ -30,12 +28,10 @@ start params = notBareRepo $ do _ -> error "Specify a repository and a description." showStart "describe" name - Remotes.readConfigs - r <- Remotes.byName name - return $ Just $ perform r description + u <- Remote.nameToUUID name + return $ Just $ perform u description -perform :: Git.Repo -> String -> CommandPerform -perform repo description = do - u <- getUUID repo +perform :: UUID -> String -> CommandPerform +perform u description = do describeUUID u description return $ Just $ Command.Init.cleanup diff --git a/Command/Semitrust.hs b/Command/Semitrust.hs index 351336b89..e64d418f8 100644 --- a/Command/Semitrust.hs +++ b/Command/Semitrust.hs @@ -8,8 +8,7 @@ module Command.Semitrust where import Command -import qualified GitRepo as Git -import qualified Remotes +import qualified Remote import UUID import Trust import Messages @@ -24,12 +23,10 @@ seek = [withString start] start :: CommandStartString start name = notBareRepo $ do showStart "semitrust" name - Remotes.readConfigs - r <- Remotes.byName name - return $ Just $ perform r + u <- Remote.nameToUUID name + return $ Just $ perform u -perform :: Git.Repo -> CommandPerform -perform repo = do - uuid <- getUUID repo +perform :: UUID -> CommandPerform +perform uuid = do trustSet uuid SemiTrusted return $ Just $ return True diff --git a/Command/Trust.hs b/Command/Trust.hs index f7dba5648..05505cd04 100644 --- a/Command/Trust.hs +++ b/Command/Trust.hs @@ -8,8 +8,7 @@ module Command.Trust where import Command -import qualified GitRepo as Git -import qualified Remotes +import qualified Remote import Trust import UUID import Messages @@ -24,12 +23,10 @@ seek = [withString start] start :: CommandStartString start name = notBareRepo $ do showStart "trust" name - Remotes.readConfigs - r <- Remotes.byName name - return $ Just $ perform r + u <- Remote.nameToUUID name + return $ Just $ perform u -perform :: Git.Repo -> CommandPerform -perform repo = do - uuid <- getUUID repo +perform :: UUID -> CommandPerform +perform uuid = do trustSet uuid Trusted return $ Just $ return True diff --git a/Command/Untrust.hs b/Command/Untrust.hs index 9c11efe46..311ec6eeb 100644 --- a/Command/Untrust.hs +++ b/Command/Untrust.hs @@ -8,8 +8,7 @@ module Command.Untrust where import Command -import qualified GitRepo as Git -import qualified Remotes +import qualified Remote import UUID import Trust import Messages @@ -24,12 +23,10 @@ seek = [withString start] start :: CommandStartString start name = notBareRepo $ do showStart "untrust" name - Remotes.readConfigs - r <- Remotes.byName name - return $ Just $ perform r + u <- Remote.nameToUUID name + return $ Just $ perform u -perform :: Git.Repo -> CommandPerform -perform repo = do - uuid <- getUUID repo +perform :: UUID -> CommandPerform +perform uuid = do trustSet uuid UnTrusted return $ Just $ return True @@ -6,12 +6,15 @@ -} module Remote ( + byName, + nameToUUID, keyPossibilities, remotesWithUUID, remotesWithoutUUID ) where import Control.Monad.State (liftIO) +import Control.Monad (when, liftM) import Data.List import RemoteClass @@ -21,6 +24,7 @@ import UUID import qualified Annex import Trust import LocationLog +import Messages {- add generators for new Remotes here -} generators :: [Annex [Remote Annex]] @@ -30,7 +34,9 @@ generators = [Remote.GitRemote.generate] - Since doing so can be expensive, the list is cached in the Annex. -} genList :: Annex [Remote Annex] genList = do - liftIO $ putStrLn "Remote.genList" + g <- Annex.gitRepo + u <- getUUID g + showNote $ "Remote.genList " ++ u rs <- Annex.getState Annex.remotes if null rs then do @@ -40,13 +46,24 @@ genList = do return rs' else return rs -{- Filters a list of remotes to ones that have the listed uuids. -} -remotesWithUUID :: [Remote Annex] -> [UUID] -> [Remote Annex] -remotesWithUUID rs us = filter (\r -> uuid r `elem` us) rs +{- Looks up a remote by name. (Or by UUID.) -} +byName :: String -> Annex (Remote Annex) +byName "" = error "no remote specified" +byName n = do + allremotes <- genList + let match = filter matching allremotes + when (null match) $ error $ + "there is no git remote named \"" ++ n ++ "\"" + return $ head match + where + matching r = n == name r || n == uuid r -{- Filters a list of remotes to ones that do not have the listed uuids. -} -remotesWithoutUUID :: [Remote Annex] -> [UUID] -> [Remote Annex] -remotesWithoutUUID rs us = filter (\r -> uuid r `notElem` us) rs +{- Looks up a remote by name (or by UUID), and returns its UUID. -} +nameToUUID :: String -> Annex UUID +nameToUUID "." = do -- special case for current repo + g <- Annex.gitRepo + getUUID g +nameToUUID n = liftM uuid (byName n) {- Cost ordered lists of remotes that the LocationLog indicate may have a key. - @@ -71,3 +88,12 @@ keyPossibilities key = do let validremotes = remotesWithUUID allremotes validuuids return (sort validremotes, validtrusteduuids) + +{- Filters a list of remotes to ones that have the listed uuids. -} +remotesWithUUID :: [Remote Annex] -> [UUID] -> [Remote Annex] +remotesWithUUID rs us = filter (\r -> uuid r `elem` us) rs + +{- Filters a list of remotes to ones that do not have the listed uuids. -} +remotesWithoutUUID :: [Remote Annex] -> [UUID] -> [Remote Annex] +remotesWithoutUUID rs us = filter (\r -> uuid r `notElem` us) rs + @@ -3,6 +3,9 @@ - Each git repository used by git-annex has an annex.uuid setting that - uniquely identifies that repository. - + - UUIDs of remotes are cached in git config, using keys named + - remote.<name>.annex-uuid + - - Copyright 2010 Joey Hess <joey@kitenet.net> - - Licensed under the GNU GPL version 3 or higher. @@ -51,11 +54,7 @@ genUUID = liftIO $ pOpen ReadFromPipe command params $ \h -> hGetLine h else [] {- Looks up a repo's UUID. May return "" if none is known. - - - - UUIDs of remotes are cached in git config, using keys named - - remote.<name>.annex-uuid - - - - -} + -} getUUID :: Git.Repo -> Annex UUID getUUID r = do g <- Annex.gitRepo @@ -334,6 +334,7 @@ test_trust = "git-annex trust/untrust/semitrust" ~: intmpclonerepo $ do git_annex "semitrust" ["-q", repo] @? "semitrust of semitrusted failed" trustcheck Trust.SemiTrusted "semitrusted 2" where + repo = "origin" trustcheck expected msg = do present <- annexeval $ do Remotes.readConfigs @@ -342,7 +343,6 @@ test_trust = "git-annex trust/untrust/semitrust" ~: intmpclonerepo $ do u <- UUID.getUUID r return $ u `elem` l assertBool msg present - repo = "origin" test_fsck :: Test test_fsck = "git-annex fsck" ~: TestList [basicfsck, withlocaluntrusted, withremoteuntrusted] |